Mercurial > emacs
diff 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 |
line wrap: on
line diff
--- a/lisp/mh-e/mh-funcs.el Sun Jan 15 23:02:10 2006 +0000 +++ b/lisp/mh-e/mh-funcs.el Mon Jan 16 00:03:54 2006 +0000 @@ -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 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -21,8 +22,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -32,34 +33,46 @@ ;;; 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) - -;;; Customization +;;(message "< mh-funcs") -(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.") + + +;;; Scan Line Formats (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. -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,44 +87,43 @@ (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) - (cons (region-beginning) (region-end))) - (current-prefix-arg - (mh-read-seq-default "Copy" t)) - (t - (cons (line-beginning-position) (line-end-position)))) +(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))) - (let ((msg-list (cond ((numberp msg-or-seq) (list msg-or-seq)) - ((symbolp msg-or-seq) (mh-seq-to-msgs msg-or-seq)) - ((and (consp msg-or-seq) (numberp (car msg-or-seq)) - (numberp (cdr msg-or-seq))) - (let ((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)))) + (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) - (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))))) + "-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." + "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 (or mh-index-data - (yes-or-no-p (format "Remove folder %s (and all included messages)?" + (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)) @@ -136,12 +148,12 @@ (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... -(defvar view-exit-action) +;; Shush compiler. +(eval-when-compile (defvar view-exit-action)) ;;;###mh-autoload (defun mh-list-folders () @@ -157,18 +169,26 @@ "-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. -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, 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) @@ -181,8 +201,8 @@ (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 @@ -193,10 +213,13 @@ (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." +(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))) @@ -206,13 +229,13 @@ (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). @@ -229,7 +252,7 @@ ;;;###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). @@ -245,65 +268,12 @@ (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-sort-folder (&optional extra-args) + "Sort folder. -(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." +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) @@ -314,15 +284,13 @@ (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." +(defun mh-undo-folder () + "Undo all refiles and deletes in the current folder." (interactive) (cond ((or mh-do-not-confirm-flag (yes-or-no-p "Undo all commands in folder? ")) @@ -331,17 +299,22 @@ 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.") - (sit-for 2)))) + (message "Commands not undone")))) ;;;###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: " @@ -355,10 +328,9 @@ ;;;###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: " @@ -378,9 +350,9 @@ (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)) @@ -389,31 +361,33 @@ (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"))) + (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 +;;;###mh-autoload (defun mh-ephem-message (string) "Display STRING in the minibuffer momentarily." (message "%s" string) @@ -422,32 +396,42 @@ ;;;###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 - (substitute-command-keys - (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) + (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." (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 - (substitute-command-keys - (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) + (with-electric-help + (function + (lambda () + (insert + (substitute-command-keys + (mapconcat 'identity + (cdr (assoc prefix-char mh-help-messages)) ""))))) + mh-help-buffer))) (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