Replace many instances of read-file-name with read-directory-name.
[bpt/emacs.git] / lisp / mh-e / mh-funcs.el
index 5c3db1d..c3f301e 100644 (file)
@@ -1,7 +1,6 @@
 ;;; mh-funcs.el --- MH-E functions not everyone will use right away
 
-;; Copyright (C) 1993, 1995,
-;;  2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2011  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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, 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.
 
+;; 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.
+
 ;;; Change Log:
 
 ;;; Code:
 
-(eval-when-compile (require 'mh-acros))
-(mh-require-cl)
 (require 'mh-e)
-
-\f
-
-;;; Scan Line Formats
-
-(defvar mh-note-copied "C"
-  "Messages that have been copied are marked by this character.")
-
-(defvar mh-note-printed "P"
-  "Messages that have been printed are marked by this character.")
-
-\f
-
-;;; Functions
+(require 'mh-scan)
 
 ;;;###mh-autoload
 (defun mh-burst-digest ()
@@ -88,7 +73,7 @@ correct the \"To:\" field yourself."
   "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 (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
@@ -149,7 +134,7 @@ Display the results only if something went wrong."
           (re-search-forward "^rmf: " (point-max) t))
     (display-buffer mh-temp-buffer)))
 
-;; Avoid compiler warning...
+;; Shush compiler.
 (defvar view-exit-action)
 
 ;;;###mh-autoload
@@ -158,15 +143,14 @@ Display the results only if something went wrong."
   (interactive)
   (let ((temp-buffer mh-folders-buffer))
     (with-output-to-temp-buffer temp-buffer
-      (save-excursion
-        (set-buffer temp-buffer)
+      (with-current-buffer temp-buffer
         (erase-buffer)
         (message "Listing folders...")
         (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
                                             "-recurse"
                                           "-norecurse"))
         (goto-char (point-min))
-        (view-mode-enter)
+        (mh-view-mode-enter)
         (setq view-exit-action 'kill-buffer)
         (message "Listing folders...done")))))
 
@@ -182,7 +166,10 @@ 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, which are lost."
+the pending refiles and deletes.
+
+The hook `mh-pack-folder-hook' is run after the folder is packed;
+see its documentation for variables it can use."
   (interactive (list (if current-prefix-arg
                          (mh-read-range "Scan" mh-current-folder t nil t
                                         mh-interpret-number-as-range-flag)
@@ -194,6 +181,7 @@ the pending refiles and deletes, which are lost."
       (mh-index-update-maps mh-current-folder))
     (cond (threaded-flag (mh-toggle-threads))
           (mh-index-data (mh-index-insert-folder-headers))))
+  (run-hooks 'mh-pack-folder-hook)
   (message "Packing folder...done"))
 
 (defun mh-pack-folder-1 (range)
@@ -209,27 +197,6 @@ Display RANGE after packing, or the entire folder if RANGE is nil."
   (mh-reset-threads-and-narrowing)
   (mh-regenerate-headers range))
 
-;;;###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 an 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-page-digest ()
   "Display next message in digest."
@@ -265,13 +232,32 @@ command."
     (mh-recenter 0)))
 
 ;;;###mh-autoload
-(defun mh-sort-folder (&optional extra-args)
-  "Sort the messages in the current folder by date.
+(defun mh-pipe-msg (command include-header)
+  "Pipe message through shell command COMMAND.
 
-Calls the MH program sortm to do the work.
+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))
+    (with-current-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)))))
 
-The arguments in the list `mh-sortm-args' are passed to sortm if
-the optional argument EXTRA-ARGS is given."
+;;;###mh-autoload
+(defun mh-sort-folder (&optional extra-args)
+  "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)
@@ -286,53 +272,35 @@ the optional argument EXTRA-ARGS is given."
     (cond (threaded-flag (mh-toggle-threads))
           (mh-index-data (mh-index-insert-folder-headers)))))
 
-;;;###mh-autoload
-(defun mh-undo-folder ()
-  "Undo all pending deletes and refiles in current folder."
-  (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-remove-all-notation)))
-        (t
-         (message "Commands not undone"))))
-
 ;;;###mh-autoload
 (defun mh-store-msg (directory)
-  "Unpack message created with `uudecode' or `shar'.
+  "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'."
+`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: "
+                       (read-directory-name "Store message in directory: "
                                        udir udir nil))))
   (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
-    (save-excursion
-      (set-buffer (get-buffer-create mh-temp-buffer))
+    (with-current-buffer (get-buffer-create mh-temp-buffer)
       (erase-buffer)
       (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.
+  "Unpack buffer created with \"uudecode\" or \"shar\".
 
-Default directory is the last directory used, or initially the
-value of `mh-store-default-directory' or the current directory."
+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: "
+                       (read-directory-name "Store buffer in directory: "
                                        udir udir nil))))
   (let ((store-directory (expand-file-name directory))
         (sh-start (save-excursion
@@ -359,8 +327,7 @@ value of `mh-store-default-directory' or the current directory."
               (setq uudecode-filename
                     (buffer-substring (point)
                                       (progn (end-of-line) (point)))))))
-    (save-excursion
-      (set-buffer (get-buffer-create mh-log-buffer))
+    (with-current-buffer (get-buffer-create mh-log-buffer)
       (setq log-begin (mh-truncate-log-buffer))
       (if (not (file-directory-p store-directory))
           (progn
@@ -377,53 +344,24 @@ value of `mh-store-default-directory' or the current directory."
       (if (equal (call-process-region sh-start (point-max) command
                                       nil mh-log-buffer t)
                  0)
-          (save-excursion
-            (set-buffer mh-log-buffer)
+          (with-current-buffer mh-log-buffer
             (insert "\n(mh-store finished)\n"))
         (error "Error occurred during execution of %s" command)))))
 
-\f
-
-;;; Help Functions
-
 ;;;###mh-autoload
-(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-E commands."
-  (interactive)
-  (with-electric-help
-   (function
-    (lambda ()
-      (insert
-       (substitute-command-keys
-        (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
-    mh-help-buffer)))
-
-;;;###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))))
-    (with-electric-help
-     (function
-      (lambda ()
-        (insert
-         (substitute-command-keys
-          (mapconcat 'identity
-                     (cdr (assoc prefix-char mh-help-messages)) "")))))
-     mh-help-buffer)))
+  (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)
 
@@ -432,5 +370,4 @@ value of `mh-store-default-directory' or the current directory."
 ;; sentence-end-double-space: nil
 ;; End:
 
-;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762
 ;;; mh-funcs.el ends here