emacs: lisp/mh-e/mh-funcs.el comparison

comparison lisp/mh-e/mh-funcs.el @ 88155:d7ddb3e565de

sync with trunk

author	Henrik Enberg <henrik.enberg@telia.com>
date	Mon, 16 Jan 2006 00:03:54 +0000
parents	0d8b17d428b5
children

comparison

equal deleted inserted replaced

-:8ce476d3ba36
+:d7ddb3e565de
 ;;; 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 Free Software Foundation, Inc.
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
 ;; Keywords: mail
 ;; See: mh-e.el
 ;; 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,
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02111-1307, USA.
+;; Boston, MA 02110-1301, 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.2 2003/02/03 20:55:30 wohler Exp $
 ;;; Code:
+;;(message "> mh-funcs")
+(eval-when-compile (require 'mh-acros))
+(mh-require-cl)
+(require 'mh-buffers)
 (require 'mh-e)
+;;(message "< mh-funcs")
-;;; Customization
-(defvar mh-sortm-args nil
-"Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
+;;; Scan Line Formats
-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.")
+"Messages that have been copied are marked by this character.")
 (defvar mh-note-printed "P"
-"String whose first character is used to notate printed messages.")
+"Messages that have been printed are marked by this character.")
 ;;; Functions
 ;;;###mh-autoload
 (defun mh-burst-digest ()
-"Burst apart the current message, which should be a digest.
+"Break up digest into separate messages\\<mh-folder-mode-map>.
-The message is replaced by its table of contents and the messages from the
-digest are inserted into the folder after that message."
+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)
 (mh-set-folder-modified-p t)        ; lock folder while bursting
 (message "Bursting digest...")
 (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)
+(defun mh-copy-msg (range folder)
-"Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
+"Copy RANGE to FOLDER\\<mh-folder-mode-map>.
-Default is the displayed message. If optional prefix argument is provided,
-then prompt for the message sequence."
+If you wish to copy a message to another folder, you can use this
-(interactive (list (cond
+command (see the \"-link\" argument to \"refile\"). Like the
-((mh-mark-active-p t)
+command \\[mh-refile-msg], this command prompts you for the name
-(cons (region-beginning) (region-end)))
+of the target folder and you can specify a range. Note that
-(current-prefix-arg
+unlike the command \\[mh-refile-msg], the copy takes place
-(mh-read-seq-default "Copy" t))
+immediately. The original copy remains in the current folder.
-(t
-(cons (line-beginning-position) (line-end-position))))
+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)))
-(let ((msg-list (cond ((numberp msg-or-seq) (list msg-or-seq))
+(let ((msg-list (let ((result ()))
-((symbolp msg-or-seq) (mh-seq-to-msgs msg-or-seq))
+(mh-iterate-on-range msg range
-((and (consp msg-or-seq) (numberp (car msg-or-seq))
+(mh-notate nil mh-note-copied mh-cmd-note)
-(numberp (cdr msg-or-seq)))
+(push msg result))
-(let ((result ()))
+result)))
-(mh-iterate-on-messages-in-region msg
-(car msg-or-seq) (cdr msg-or-seq)
-(mh-notate nil mh-note-copied mh-cmd-note)
-(push msg result))
-result))
-(t msg-or-seq))))
 (mh-exec-cmd "refile" (mh-coalesce-msg-list msg-list)
-"-link" "-src" mh-current-folder folder)
+"-link" "-src" mh-current-folder folder)))
-(cond ((numberp msg-or-seq)
-(mh-notate msg-or-seq mh-note-copied mh-cmd-note))
-((symbolp msg-or-seq)
-(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.
+"Remove folder.
-Removes all of the messages (files) within the specified current folder,
-and then removes the folder (directory) itself."
+Remove all of the messages (files) within the current folder, and
-(interactive)
+then remove the folder (directory) itself.
-(if (or mh-index-data
-(yes-or-no-p (format "Remove folder %s (and all included messages)?"
+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 (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" 'mh-rmf-daemon folder)
 "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
-(beginning-of-buffer)
+(goto-char (point-min))
 (re-search-forward "^rmf: " (point-max) t))
 (display-buffer mh-temp-buffer)))
-;; Avoid compiler warning...
+;; Shush compiler.
-(defvar view-exit-action)
+(eval-when-compile (defvar view-exit-action))
 ;;;###mh-autoload
 (defun mh-list-folders ()
 "List mail folders."
 (interactive)
 (message "Listing folders...")
 (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
 "-recurse"
 "-norecurse"))
 (goto-char (point-min))
-(view-mode 1)
+(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.
+"Pack folder\\<mh-folder-mode-map>.
-First, offer to execute any outstanding commands for the current folder. If
-optional prefix argument provided, prompt for the RANGE of messages to display
+This command packs the folder, removing gaps from the numbering
-after packing. Otherwise, show the entire folder."
+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, which are lost."
 (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)
 (mh-goto-cur-msg)
 (when mh-index-data
 (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."
+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
 (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)
+(defun mh-pipe-msg (command include-header)
-"Pipe the current message through the given shell COMMAND.
+"Pipe message through shell command COMMAND.
-If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
-Otherwise just send the message's body without the headers."
+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-headers) (search-forward "\n\n"))
+(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 ()
-"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).
 (move-to-window-line 0)
 (let ((case-fold-search nil))
 (forward-line 2)
 (mh-recenter 0)))
 ;;;###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).
 (move-to-window-line 0)
 (let ((case-fold-search nil))
 (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 nil "-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.
+"Sort folder.
-Calls the MH program sortm to do the work.
-The arguments in the list `mh-sortm-args' are passed to sortm if the optional
+By default, messages are sorted by date. The option
-argument EXTRA-ARGS is given."
+`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)
 (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)
+(defun mh-undo-folder ()
-"Undo all pending deletes and refiles in current folder.
+"Undo all refiles and deletes in the 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)))
+(mh-remove-all-notation)))
 (t
-(message "Commands not undone.")
+(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.
+"Unpack message created with \"uudecode\" or \"shar\".
-The message can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
+The default DIRECTORY for extraction is the current directory;
-`mh-store-default-directory' or 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: "
 udir udir nil))))
 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
 (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.
+"Unpack buffer created with \"uudecode\" or \"shar\".
-The buffer can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
+See `mh-store-msg' for a description of DIRECTORY."
-`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))
 (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)"))
+(uudecode-filename "(unknown filename)")
+log-begin)
 (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)
+(set-buffer (get-buffer-create mh-log-buffer))
-(erase-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
+(set-window-start (display-buffer mh-log-buffer) log-begin) ;watch progress
-(let (value)
+(let ((default-directory (file-name-as-directory store-directory)))
-(let ((default-directory (file-name-as-directory store-directory)))
+(if (equal (call-process-region sh-start (point-max) command
-(setq value (call-process-region sh-start (point-max) command
+nil mh-log-buffer t)
-nil log-buffer t)))
+0)
-(set-buffer log-buffer)
+(save-excursion
-(mh-handle-process-error command value))
+(set-buffer mh-log-buffer)
-(insert "\n(mh-store finished)\n")))
+(insert "\n(mh-store finished)\n"))
+(error "Error occurred during execution of %s" command)))))
 ;;; 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-Folder commands in minibuffer."
+"Display cheat sheet for the MH-E commands."
 (interactive)
-(mh-ephem-message
+(with-electric-help
-(substitute-command-keys
+(function
-(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
+(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."
 (interactive)
-;; We got here because the user pressed a `?', but he pressed a prefix key
+;; 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
+(with-electric-help
-(substitute-command-keys
+(function
-(mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
+(lambda ()
+(insert
+(substitute-command-keys
+(mapconcat 'identity
+(cdr (assoc prefix-char mh-help-messages)) "")))))
+mh-help-buffer)))
 (provide 'mh-funcs)
-;;; Local Variables:
+;; Local Variables:
-;;; indent-tabs-mode: nil
+;; indent-tabs-mode: nil
-;;; sentence-end-double-space: nil
+;; sentence-end-double-space: nil
-;;; End:
+;; End:
+;; arch-tag: 1936c4f1-4843-438e-bc4b-a63bb75a7762
 ;;; mh-funcs.el ends here

Mercurial > emacs

comparison lisp/mh-e/mh-funcs.el @ 88155:d7ddb3e565de