]> code.delx.au - gnu-emacs/blobdiff - lisp/mh-e/mh-funcs.el
* mh-e.el (mh-invisible-header-fields-internal): Remove Newsgroups
[gnu-emacs] / lisp / mh-e / mh-funcs.el
index f2ffeede00229ddff1947c6c6ce1b33c44e35129..d9f68f788712083931184670a8974c95723128c2 100644 (file)
@@ -1,6 +1,7 @@
 ;;; mh-funcs.el --- MH-E functions not everyone will use right away
 
-;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995,
+;;  2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
-;; Internal support for MH-E package.
 ;; Putting these functions in a separate file lets MH-E start up faster,
 ;; since less Lisp code needs to be loaded all at once.
 
-;;; Change Log:
+;; 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.
 
-;; $Id: mh-funcs.el,v 1.9 2003/01/08 23:21:16 wohler Exp $
+;;; Change Log:
 
 ;;; Code:
 
 (require 'mh-e)
-
-;;; Customization
-
-(defvar mh-sortm-args nil
-  "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
-The arguments are passed to sortm if \\[mh-sort-folder] is given a
-prefix argument.  Normally default arguments to sortm are specified in the
-MH profile.
-For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
-
-(defvar mh-note-copied "C"
-  "String whose first character is used to notate copied messages.")
-
-(defvar mh-note-printed "P"
-  "String whose first character is used to notate printed messages.")
-
-;;; Functions
+(require 'mh-scan)
 
 ;;;###mh-autoload
 (defun mh-burst-digest ()
-  "Burst apart the current message, which should be a digest.
-The message is replaced by its table of contents and the messages from the
-digest are inserted into the folder after that message."
+  "Break up digest into separate messages\\<mh-folder-mode-map>.
+
+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."
   (interactive)
   (let ((digest (mh-get-msg-num t)))
     (mh-process-or-undo-commands mh-current-folder)
@@ -74,63 +70,79 @@ digest are inserted into the folder after that message."
     (message "Bursting digest...done")))
 
 ;;;###mh-autoload
-(defun mh-copy-msg (msg-or-seq folder)
-  "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
-Default is the displayed message. If optional prefix argument is provided,
-then prompt for the message sequence."
-  (interactive (list (cond
-                      ((mh-mark-active-p t)
-                       (mh-region-to-msg-list (region-beginning) (region-end)))
-                      (current-prefix-arg
-                       (mh-read-seq-default "Copy" t))
-                      (t
-                       (mh-get-msg-num t)))
+(defun mh-copy-msg (range folder)
+  "Copy RANGE to FOLDER\\<mh-folder-mode-map>.
+
+If you wish to copy a message to another folder, you can use this
+command (see the \"-link\" argument to \"refile\"). Like the
+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.
+
+Check the documentation of `mh-interactive-range' to see how
+RANGE is read in interactive use."
+  (interactive (list (mh-interactive-range "Copy")
                      (mh-prompt-for-folder "Copy to" "" t)))
-  (mh-exec-cmd "refile"
-               (cond ((numberp msg-or-seq) msg-or-seq)
-                     ((listp msg-or-seq) msg-or-seq)
-                     (t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
-               "-link" "-src" mh-current-folder folder)
-  (if (numberp msg-or-seq)
-      (mh-notate msg-or-seq mh-note-copied mh-cmd-note)
-    (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
+  (let ((msg-list (let ((result ()))
+                    (mh-iterate-on-range msg range
+                      (mh-notate nil mh-note-copied mh-cmd-note)
+                      (push msg result))
+                    result)))
+    (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
+                 "-link" "-src" mh-current-folder folder)))
 
 ;;;###mh-autoload
 (defun mh-kill-folder ()
-  "Remove the current folder and all included messages.
-Removes all of the messages (files) within the specified current folder,
-and then removes the folder (directory) itself.
-The value of `mh-folder-list-change-hook' is a list of functions to be called,
-with no arguments, after the folders has been removed."
+  "Remove folder.
+
+Remove all of the messages (files) within the current folder, and
+then remove the folder (directory) itself.
+
+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."
   (interactive)
-  (if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
-                           mh-current-folder))
-      (let ((folder mh-current-folder))
-        (if (null mh-folder-list)
-            (mh-set-folder-list))
+  (if (or (run-hook-with-args-until-success
+           'mh-kill-folder-suppress-prompt-hooks)
+          (yes-or-no-p (format "Remove folder %s (and all included messages)? "
+                               mh-current-folder)))
+      (let ((folder mh-current-folder)
+            (window-config mh-previous-window-config))
         (mh-set-folder-modified-p t)    ; lock folder to kill it
-        (mh-exec-cmd-daemon "rmf" folder)
-        (setq mh-folder-list
-              (delq (assoc folder mh-folder-list) mh-folder-list))
+        (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
         (when (boundp 'mh-speed-folder-map)
           (mh-speed-invalidate-map folder))
-        (run-hooks 'mh-folder-list-change-hook)
-        (message "Folder %s removed" folder)
+        (mh-remove-from-sub-folders-cache folder)
         (mh-set-folder-modified-p nil)  ; so kill-buffer doesn't complain
-        (if (get-buffer mh-show-buffer)
+        (if (and mh-show-buffer (get-buffer mh-show-buffer))
             (kill-buffer mh-show-buffer))
         (if (get-buffer folder)
-            (kill-buffer folder)))
+            (kill-buffer folder))
+        (when window-config
+          (set-window-configuration window-config))
+        (message "Folder %s removed" folder))
     (message "Folder not removed")))
 
-;; Avoid compiler warning...
+(defun mh-rmf-daemon (process output)
+  "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
+          (goto-char (point-min))
+          (re-search-forward "^rmf: " (point-max) t))
+    (display-buffer mh-temp-buffer)))
+
+;; Shush compiler.
 (defvar view-exit-action)
 
 ;;;###mh-autoload
 (defun mh-list-folders ()
   "List mail folders."
   (interactive)
-  (let ((temp-buffer mh-temp-folders-buffer))
+  (let ((temp-buffer mh-folders-buffer))
     (with-output-to-temp-buffer temp-buffer
       (save-excursion
         (set-buffer temp-buffer)
@@ -140,18 +152,26 @@ with no arguments, after the folders has been removed."
                                             "-recurse"
                                           "-norecurse"))
         (goto-char (point-min))
-        (view-mode 1)
+        (mh-view-mode-enter)
         (setq view-exit-action 'kill-buffer)
         (message "Listing folders...done")))))
 
 ;;;###mh-autoload
 (defun mh-pack-folder (range)
-  "Renumber the messages of a folder to be 1..n.
-First, offer to execute any outstanding commands for the current folder. If
-optional prefix argument provided, prompt for the RANGE of messages to display
-after packing. Otherwise, show the entire folder."
+  "Pack folder\\<mh-folder-mode-map>.
+
+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.
+
+This command will ask if you want to process refiles or deletes
+first and then either run \\[mh-execute-commands] for you or undo
+the pending refiles and deletes."
   (interactive (list (if current-prefix-arg
-                         (mh-read-msg-range mh-current-folder t)
+                         (mh-read-range "Scan" mh-current-folder t nil t
+                                        mh-interpret-number-as-range-flag)
                        '("all"))))
   (let ((threaded-flag (memq 'unthread mh-view-ops)))
     (mh-pack-folder-1 range)
@@ -164,8 +184,8 @@ after packing. Otherwise, show the entire folder."
 
 (defun mh-pack-folder-1 (range)
   "Close and pack the current folder.
-Display the given RANGE of messages after packing. If RANGE is nil, show the
-entire folder."
+
+Display RANGE after packing, or the entire folder if RANGE is nil."
   (mh-process-or-undo-commands mh-current-folder)
   (message "Packing folder...")
   (mh-set-folder-modified-p t)          ; lock folder while packing
@@ -175,27 +195,9 @@ entire folder."
   (mh-reset-threads-and-narrowing)
   (mh-regenerate-headers range))
 
-;;;###mh-autoload
-(defun mh-pipe-msg (command include-headers)
-  "Pipe the current message through the given shell COMMAND.
-If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
-Otherwise just send the message's body without the headers."
-  (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))
-    (save-excursion
-      (set-buffer (get-buffer-create mh-temp-buffer))
-      (erase-buffer)
-      (insert-file-contents msg-file-to-pipe)
-      (goto-char (point-min))
-      (if (not include-headers) (search-forward "\n\n"))
-      (let ((default-directory message-directory))
-        (shell-command-on-region (point) (point-max) command nil)))))
-
 ;;;###mh-autoload
 (defun mh-page-digest ()
-  "Advance displayed message to next digested message."
+  "Display next message in digest."
   (interactive)
   (mh-in-show-buffer (mh-show-buffer)
     ;; Go to top of screen (in case user moved point).
@@ -212,7 +214,7 @@ Otherwise just send the message's body without the headers."
 
 ;;;###mh-autoload
 (defun mh-page-digest-backwards ()
-  "Back up displayed message to previous digested message."
+  "Display previous message in digest."
   (interactive)
   (mh-in-show-buffer (mh-show-buffer)
     ;; Go to top of screen (in case user moved point).
@@ -228,65 +230,33 @@ Otherwise just send the message's body without the headers."
     (mh-recenter 0)))
 
 ;;;###mh-autoload
-(defun mh-print-msg (msg-or-seq)
-  "Print MSG-OR-SEQ (default: displayed message) on printer.
-If optional prefix argument provided, then prompt for the message sequence.
-The variable `mh-lpr-command-format' is used to generate the print command.
-The messages are formatted by mhl. See the variable `mhl-formfile'."
-  (interactive (list (if current-prefix-arg
-                         (reverse (mh-seq-to-msgs
-                                   (mh-read-seq-default "Print" t)))
-                       (mh-get-msg-num t))))
-  (if (numberp msg-or-seq)
-      (message "Printing message...")
-    (message "Printing sequence..."))
-  (let ((print-command
-         (if (numberp msg-or-seq)
-             (format "%s -nobell -clear %s %s | %s"
-                     (expand-file-name "mhl" mh-lib-progs)
-                     (mh-msg-filename msg-or-seq)
-                     (if (stringp mhl-formfile)
-                         (format "-form %s" mhl-formfile)
-                       "")
-                     (format mh-lpr-command-format
-                             (if (numberp msg-or-seq)
-                                 (format "%s/%d" mh-current-folder
-                                         msg-or-seq)
-                               (format "Sequence from %s" mh-current-folder))))
-           (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
-                   (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
-                   (expand-file-name "mhl" mh-lib-progs)
-                   (if (stringp mhl-formfile)
-                       (format "-form %s" mhl-formfile)
-                     "")
-                   (mh-msg-filenames msg-or-seq)
-                   (format mh-lpr-command-format
-                           (if (numberp msg-or-seq)
-                               (format "%s/%d" mh-current-folder
-                                       msg-or-seq)
-                             (format "Sequence from %s"
-                                     mh-current-folder)))))))
-    (if mh-print-background-flag
-        (mh-exec-cmd-daemon shell-file-name "-c" print-command)
-      (call-process shell-file-name nil nil nil "-c" print-command))
-    (if (numberp msg-or-seq)
-        (mh-notate msg-or-seq mh-note-printed mh-cmd-note)
-      (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
-    (mh-add-msgs-to-seq msg-or-seq 'printed t)
-    (if (numberp msg-or-seq)
-        (message "Printing message...done")
-      (message "Printing sequence...done"))))
-
-(defun mh-msg-filenames (msgs &optional folder)
-  "Return a list of file names for MSGS in FOLDER (default current folder)."
-  (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
+(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))
+    (save-excursion
+      (set-buffer (get-buffer-create mh-temp-buffer))
+      (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)))))
 
 ;;;###mh-autoload
 (defun mh-sort-folder (&optional extra-args)
-  "Sort the messages in the current folder by date.
-Calls the MH program sortm to do the work.
-The arguments in the list `mh-sortm-args' are passed to sortm if the optional
-argument EXTRA-ARGS is given."
+  "Sort folder.
+
+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."
   (interactive "P")
   (mh-process-or-undo-commands mh-current-folder)
   (setq mh-next-direction 'forward)
@@ -297,34 +267,22 @@ argument EXTRA-ARGS is given."
     (when mh-index-data
       (mh-index-update-maps mh-current-folder))
     (message "Sorting folder...done")
-    (mh-reset-threads-and-narrowing)
     (mh-scan-folder mh-current-folder "all")
     (cond (threaded-flag (mh-toggle-threads))
           (mh-index-data (mh-index-insert-folder-headers)))))
 
-;;;###mh-autoload
-(defun mh-undo-folder (&rest ignore)
-  "Undo all pending deletes and refiles in current folder.
-Argument IGNORE is deprecated."
-  (interactive)
-  (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
-               mh-seq-list nil
-               mh-next-direction 'forward)
-         (with-mh-folder-updating (nil)
-           (mh-unmark-all-headers t)))
-        (t
-         (message "Commands not undone.")
-         (sit-for 2))))
-
 ;;;###mh-autoload
 (defun mh-store-msg (directory)
-  "Store the file(s) contained in the current message into DIRECTORY.
-The message can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory."
+  "Unpack message created with \"uudecode\" or \"shar\".
+
+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
+`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."
   (interactive (list (let ((udir (or mh-store-default-directory
                                      default-directory)))
                        (read-file-name "Store message in directory: "
@@ -336,12 +294,10 @@ Default directory is the last directory used, or initially the value of
       (insert-file-contents msg-file-to-store)
       (mh-store-buffer directory))))
 
-;;;###mh-autoload
 (defun mh-store-buffer (directory)
-  "Store the file(s) contained in the current buffer into DIRECTORY.
-The buffer can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory."
+  "Unpack buffer created with \"uudecode\" or \"shar\".
+
+See `mh-store-msg' for a description of DIRECTORY."
   (interactive (list (let ((udir (or mh-store-default-directory
                                      default-directory)))
                        (read-file-name "Store buffer in directory: "
@@ -361,9 +317,9 @@ Default directory is the last directory used, or initially the value of
                           (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
                               nil       ;most likely end of a uuencode
                             (point))))))
-        (log-buffer (get-buffer-create "*Store Output*"))
         (command "sh")
-        (uudecode-filename "(unknown filename)"))
+        (uudecode-filename "(unknown filename)")
+        log-begin)
     (if (not sh-start)
         (save-excursion
           (goto-char (point-min))
@@ -372,65 +328,49 @@ Default directory is the last directory used, or initially the value of
                     (buffer-substring (point)
                                       (progn (end-of-line) (point)))))))
     (save-excursion
-      (set-buffer log-buffer)
-      (erase-buffer)
+      (set-buffer (get-buffer-create mh-log-buffer))
+      (setq log-begin (mh-truncate-log-buffer))
       (if (not (file-directory-p store-directory))
           (progn
             (insert "mkdir " directory "\n")
-            (call-process "mkdir" nil log-buffer t store-directory)))
+            (call-process "mkdir" nil mh-log-buffer t store-directory)))
       (insert "cd " directory "\n")
       (setq mh-store-default-directory directory)
       (if (not sh-start)
           (progn
             (setq command "uudecode")
             (insert uudecode-filename " being uudecoded...\n"))))
-    (set-window-start (display-buffer log-buffer) 0) ;watch progress
-    (let (value)
-      (let ((default-directory (file-name-as-directory store-directory)))
-        (setq value (call-process-region sh-start (point-max) command
-                                         nil log-buffer t)))
-      (set-buffer log-buffer)
-      (mh-handle-process-error command value))
-    (insert "\n(mh-store finished)\n")))
-
-\f
+    (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)
+          (save-excursion
+            (set-buffer mh-log-buffer)
+            (insert "\n(mh-store finished)\n"))
+        (error "Error occurred during execution of %s" command)))))
 
-;;; Help Functions
-
-(defun mh-ephem-message (string)
-  "Display STRING in the minibuffer momentarily."
-  (message "%s" string)
-  (sit-for 5)
-  (message ""))
-
-;;;###mh-autoload
-(defun mh-help ()
-  "Display cheat sheet for the MH-Folder commands in minibuffer."
-  (interactive)
-  (mh-ephem-message
-   (substitute-command-keys
-    (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
-        
 ;;;###mh-autoload
-(defun mh-prefix-help ()
-  "Display cheat sheet for the commands of the current prefix in minibuffer."
+(defun mh-undo-folder ()
+  "Undo all refiles and deletes in the current folder."
   (interactive)
-  ;; We got here because the user pressed a `?', but he pressed a prefix key
-  ;; before that. Since the the key vector starts at index 0, the index of the
-  ;; last keystroke is length-1 and thus the second to last keystroke is at
-  ;; length-2. We use that information to obtain a suitable prefix character
-  ;; from the recent keys.
-  (let* ((keys (recent-keys))
-         (prefix-char (elt keys (- (length keys) 2))))
-    (mh-ephem-message
-     (substitute-command-keys
-      (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
+  (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
+               mh-seq-list nil
+               mh-next-direction 'forward)
+         (with-mh-folder-updating (nil)
+           (mh-remove-all-notation)))
+        (t
+         (message "Commands not undone"))))
 
 (provide 'mh-funcs)
 
-;;; Local Variables:
-;;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
-;;; End:
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; sentence-end-double-space: nil
+;; End:
 
+;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762
 ;;; mh-funcs.el ends here