diff lisp/mh-e/mh-funcs.el @ 49459:06b77df47802

* mh-e: Created directory. ChangeLog will appear in a week when we release version 7.2. * lisp/mail/mh-alias.el, lisp/mail/mh-comp.el, lisp/mail/mh-customize.el, lisp/mail/mh-e.el, lisp/mail/mh-funcs.el, lisp/mail/mh-identity.el, lisp/mail/mh-index.el, lisp/mail/mh-loaddefs.el, lisp/mail/mh-mime.el, lisp/mail/mh-pick.el, lisp/mail/mh-seq.el, lisp/mail/mh-speed.el, lisp/mail/mh-utils.el, lisp/mail/mh-xemacs-compat.el: Moved to mh-e. Note that reply2.pbm and reply2.xpm, which were created by the MH-E package, were left in mail since they can probably be used by other mail packages. * makefile.w32-in (WINS): Added mh-e. * makefile.nt (WINS): Added mh-e.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mh-e/mh-funcs.el	Sun Jan 26 02:38:37 2003 +0000
@@ -0,0 +1,436 @@
+;;; mh-funcs.el --- MH-E functions not everyone will use right away
+
+;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Bill Wohler <[e-mail]>
+;; Maintainer: Bill Wohler <[e-mail]>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; 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
+;; 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.
+
+;;; 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:
+
+;; $Id: mh-funcs.el,v 1.9 2003/01/08 23:21:16 wohler Exp $
+
+;;; 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
+
+;;;###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."
+  (interactive)
+  (let ((digest (mh-get-msg-num t)))
+    (mh-process-or-undo-commands mh-current-folder)
+    (mh-set-folder-modified-p t)        ; lock folder while bursting
+    (message "Bursting digest...")
+    (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
+    (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)
+    (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)))
+                     (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)))
+
+;;;###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."
+  (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))
+        (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))
+        (when (boundp 'mh-speed-folder-map)
+          (mh-speed-invalidate-map folder))
+        (run-hooks 'mh-folder-list-change-hook)
+        (message "Folder %s removed" folder)
+        (mh-set-folder-modified-p nil)  ; so kill-buffer doesn't complain
+        (if (get-buffer mh-show-buffer)
+            (kill-buffer mh-show-buffer))
+        (if (get-buffer folder)
+            (kill-buffer folder)))
+    (message "Folder not removed")))
+
+;; Avoid compiler warning...
+(defvar view-exit-action)
+
+;;;###mh-autoload
+(defun mh-list-folders ()
+  "List mail folders."
+  (interactive)
+  (let ((temp-buffer mh-temp-folders-buffer))
+    (with-output-to-temp-buffer temp-buffer
+      (save-excursion
+        (set-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 1)
+        (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."
+  (interactive (list (if current-prefix-arg
+                         (mh-read-msg-range mh-current-folder t)
+                       '("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))))
+  (message "Packing folder...done"))
+
+(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."
+  (mh-process-or-undo-commands mh-current-folder)
+  (message "Packing folder...")
+  (mh-set-folder-modified-p t)          ; lock folder while packing
+  (save-excursion
+    (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
+                       "-norecurse" "-fast"))
+  (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."
+  (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)
+               (re-search-forward "^From:" nil t))
+          (error "No more messages in digest")))
+    ;; 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)))
+
+;;;###mh-autoload
+(defun mh-page-digest-backwards ()
+  "Back up displayed message to previous digested message."
+  (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)
+               (re-search-backward "^From:" nil t))
+          (error "No previous message in digest")))
+    ;; Go back to previous blank line, then forward to the first non-blank.
+    (if (search-backward "\n\n" nil t)
+        (forward-line 2))
+    (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 " "))
+
+;;;###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."
+  (interactive "P")
+  (mh-process-or-undo-commands mh-current-folder)
+  (setq mh-next-direction 'forward)
+  (mh-set-folder-modified-p t)          ; lock folder while sorting
+  (message "Sorting folder...")
+  (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-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."
+  (interactive (list (let ((udir (or mh-store-default-directory
+                                     default-directory)))
+                       (read-file-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))
+      (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.
+Default directory is the last directory used, or initially the value of
+`mh-store-default-directory' or the current directory."
+  (interactive (list (let ((udir (or mh-store-default-directory
+                                     default-directory)))
+                       (read-file-name "Store buffer in directory: "
+                                       udir udir nil))))
+  (let ((store-directory (expand-file-name directory))
+        (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))))))
+        (log-buffer (get-buffer-create "*Store Output*"))
+        (command "sh")
+        (uudecode-filename "(unknown filename)"))
+    (if (not sh-start)
+        (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)))))))
+    (save-excursion
+      (set-buffer log-buffer)
+      (erase-buffer)
+      (if (not (file-directory-p store-directory))
+          (progn
+            (insert "mkdir " directory "\n")
+            (call-process "mkdir" nil 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")))
+
+
+
+;;; 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."
+  (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)) "")))))
+
+(provide 'mh-funcs)
+
+;;; Local Variables:
+;;; indent-tabs-mode: nil
+;;; sentence-end-double-space: nil
+;;; End:
+
+;;; mh-funcs.el ends here