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

comparison lisp/mh-e/mh-e.el @ 89966:d8411455de48

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-32 Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-486 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-487 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-488 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-489 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-490 Update from CVS: man/fixit.texi (Spelling): Fix typo. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-491 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-494 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-495 Update from CVS: Add missing lisp/mh-e files * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-496 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-499 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-500 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-513 Update from CVS

author	Miles Bader <miles@gnu.org>
date	Fri, 27 Aug 2004 07:00:34 +0000
parents	97905c4f1a42 25da1d331c99
children	4da4a09e8b1b

comparison

equal deleted inserted replaced

-:5e9097d1ad99
+:d8411455de48
 ;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,
 ;;  2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
 ;; Author: Bill Wohler <wohler@newt.com>
 ;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 7.4.4
+;; Version: 7.82
 ;; Keywords: mail
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;;; Change Log:
 ;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
 ;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
-;; Rewritten for GNU Emacs, James Larus 1985.  larus@ginger.berkeley.edu
+;; Rewritten for GNU Emacs, James Larus, 1985.
-;; Modified by Stephen Gildea 1988.  gildea@lcs.mit.edu
+;; Modified by Stephen Gildea, 1988.
-;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
+;; Maintenance picked up by Bill Wohler and the
-;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
+;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
 ;;; Code:
 (provide 'mh-e)
+(eval-when-compile (require 'mh-acros))
+(mh-require-cl)
 (require 'mh-utils)
-(mh-require-cl)
+(require 'mh-init)
-(defvar recursive-load-depth-limit)
-(eval-when (compile load eval)
-(if (and (boundp 'recursive-load-depth-limit)
-(integerp recursive-load-depth-limit)
-(> 50 recursive-load-depth-limit))
-(setq recursive-load-depth-limit 50)))
 (require 'mh-inc)
+(require 'mh-seq)
 (require 'gnus-util)
 (require 'easymenu)
 ;; Shush the byte-compiler
 (defvar font-lock-auto-fontify)
 (defvar font-lock-defaults)
-(defconst mh-version "7.4.4" "Version number of MH-E.")
+(defconst mh-version "7.82" "Version number of MH-E.")
 ;;; Autoloads
 (autoload 'Info-goto-node "info")
-(defvar mh-note-deleted "D"
-"String whose first character is used to notate deleted messages.")
-(defvar mh-note-refiled "^"
-"String whose first character is used to notate refiled messages.")
-(defvar mh-note-cur "+"
-"String whose first character is used to notate the current message.")
 (defvar mh-partial-folder-mode-line-annotation "select"
 "Annotation when displaying part of a folder.
 The string is displayed after the folder's name.  nil for no annotation.")
+;;; Scan Line Formats
 ;;; Parameterize MH-E to work with different scan formats.  The defaults work
 ;;; with the standard MH scan listings, in which the first 4 characters on
 ;;; the line are the message number, followed by two places for notations.
-;; The following scan formats are passed to the scan program if the
+;; The following scan formats are passed to the scan program if the setting of
-;; setting of `mh-scan-format-file' above is nil.  They are identical
+;; `mh-scan-format-file' is t. They are identical except the later one makes
-;; except the later one makes use of the nmh `decode' function to
+;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just
-;; decode RFC 2047 encodings. If you just want to change the width of
+;; want to change the width of the msg number, use the `mh-set-cmd-note'
-;; the msg number, use the `mh-set-cmd-note' function.
+;; function.
 (defvar mh-scan-format-mh
 (concat
 "%4(msg)"
 "%<(cur)+%| %>"
 "*Scan format string for MH, provided to the scan program via the -format arg.
 This format is identical to the default except that additional hints for
 fontification have been added to the fifth column (remember that in Emacs, the
 first column is 0).
-The values of the fifth column, in priority order, are: `-' if the
+The values of the fifth column, in priority order, are: `-' if the message has
-message has been replied to, t if an address on the To: line matches
+been replied to, t if an address on the To: line matches one of the
-one of the mailboxes of the current user, `c' if the Cc: line matches,
+mailboxes of the current user, `c' if the Cc: line matches, `b' if the Bcc:
-`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
+line matches, and `n' if a non-empty Newsgroups: header is present.")
-is present.")
 (defvar mh-scan-format-nmh
 (concat
 "%4(msg)"
 "%<(cur)+%| %>"
 This string is passed to the scan program via the -format arg.
 This format is identical to the default except that additional hints for
 fontification have been added to the fifth column (remember that in Emacs, the
 first column is 0).
-The values of the fifth column, in priority order, are: `-' if the
+The values of the fifth column, in priority order, are: `-' if the message has
-message has been replied to, t if an address on the To: line matches
+been replied to, t if an address on the To: field matches one of the
-one of the mailboxes of the current user, `c' if the Cc: line matches,
+mailboxes of the current user, `c' if the Cc: field matches, `b' if the Bcc:
-`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
+field matches, and `n' if a non-empty Newsgroups: field is present.")
-is present.")
+(defvar mh-note-deleted ?D
+"Deleted messages are marked by this character.
+See also `mh-scan-deleted-msg-regexp'.")
+(defvar mh-note-refiled ?^
+"Refiled messages are marked by this character.
+See also `mh-scan-refiled-msg-regexp'.")
+(defvar mh-note-cur ?+
+"The current message (in MH) is marked by this character.
+See also `mh-scan-cur-msg-number-regexp'.")
 (defvar mh-scan-good-msg-regexp  "^\\( *[0-9]+\\)[^D^0-9]"
-"Regexp specifying the scan lines that are 'good' messages.
+"This regexp specifies the scan lines that are 'good' messages.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-at least one parenthesized expression which matches the message number.")
+expression to contain at least one parenthesized expression which matches the
+message number as in the default of \"^\\\\( *[0-9]+\\\\)[^D^0-9]\".")
 (defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
-"Regexp matching scan lines of deleted messages.
+"This regexp matches deleted messages.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-at least one parenthesized expression which matches the message number.")
+expression to contain at least one parenthesized expression which matches the
+message number as in the default of \"^\\\\( *[0-9]+\\\\)D\".
+See also `mh-note-deleted'.")
 (defvar mh-scan-refiled-msg-regexp  "^\\( *[0-9]+\\)\\^"
-"Regexp matching scan lines of refiled messages.
+"This regexp matches refiled messages.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-at least one parenthesized expression which matches the message number.")
+expression to contain at least one parenthesized expression which matches the
+message number as in the default of \"^\\\\( *[0-9]+\\\\)\\\\^\".
+See also `mh-note-refiled'.")
 (defvar mh-scan-valid-regexp "^ *[0-9]"
-"Regexp matching scan lines for messages (not error messages).")
+"This regexp matches scan lines for messages (not error messages).")
 (defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
-"Regexp matching scan line for the current message.
+"This regexp matches the current message.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-at least one parenthesized expression which matches the message number.
+expression to contain at least one parenthesized expression which matches the
-Don't disable this regexp as it's needed by non fontifying functions.")
+message number as in the default of \"^\\\\( *[0-9]+\\\\+\\\\).*\". Don't
+disable this regexp as it's needed by non-fontifying functions.
-(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
+See also `mh-note-cur'.")
-"Regexp matching scan line for the current message.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the whole line.
-To enable this feature, remove the string DISABLED from the regexp.")
 (defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
-"Regexp matching a valid date in scan lines.
+"This regexp matches a valid date.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-only one parenthesized expression which matches the date field
+expression to contain only one parenthesized expression which matches the date
-\(see `mh-scan-format-regexp').")
+field as in the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}.
+See also `mh-scan-format-regexp'.")
 (defvar mh-scan-rcpt-regexp  "\\(To:\\)\\(..............\\)"
-"Regexp specifying the recipient in scan lines for messages we sent.
+"This regexp specifies the recipient in messages you sent.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords'
-two parenthesized expressions.  The first is expected to match the To:
+expects this expression to contain two parenthesized expressions. The
-that the default scan format file generates.  The second is expected to match
+first is expected to match the `To:' that the default scan format
-the recipient's name.")
+file generates. The second is expected to match the recipient's name
+as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\".")
 (defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
-"Regexp matching the message body beginning displayed in scan lines.
+"This regexp matches the message body fragment displayed in scan lines.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-at least one parenthesized expression which matches the body text.")
+expression to contain at least one parenthesized expression which matches the
+body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\".")
 (defvar mh-scan-subject-regexp
-;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
-"*Regexp matching the subject string in MH folder mode.
+"This regexp matches the subject.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-at least tree parenthesized expressions. The first is expected to match the Re:
+expression to contain at least three parenthesized expressions. The first is
-string, if any. The second matches an optional bracketed number after Re,
+expected to match the `Re:' string, if any. The second matches an optional
-such as in Re[2]: and the third is expected to match the subject line itself.")
+bracketed number after `Re:', such as in `Re[2]:' (and is thus a
+sub-expression of the first expression) and the third is expected to match
+the subject line itself as in the default of \"^ *[0-9]+........[ ]*...................\\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*\\\\([^<\\n]*\\\\)\".")
 (defvar mh-scan-format-regexp
 (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
-"Regexp matching the output of scan.
+"This regexp matches the output of scan.
-The default value is based upon the default values of either
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
-`mh-scan-format-mh' or `mh-scan-format-nmh'.
+expression to contain at least three parenthesized expressions. The first
-The default `mh-folder-font-lock-keywords' expects this expression to contain
+should match the fontification hint, the second is found in
-at least three parenthesized expressions. The first should match the
+`mh-scan-date-regexp', and the third should match the user name as in the
-fontification hint, the second is found in `mh-scan-date-regexp', and the
+default of \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp
-third should match the user name.")
+\"*\\\\(..................\\\\)\")\".")
 (defvar mh-folder-font-lock-keywords
 (list
 '(1 mh-folder-to-face) ;; To:
 '(2 mh-folder-address-face)) ;; address
 ;; scan font-lock name
 (list mh-scan-format-regexp
 '(1 mh-folder-date-face)
-'(3 mh-folder-scan-format-face))
+'(3 mh-folder-scan-format-face)))
-;; Current message line
-(list mh-scan-cur-msg-regexp
-'(1 mh-folder-cur-msg-face prepend t)))
 "Regexp keywords used to fontify the MH-Folder buffer.")
 (defvar mh-scan-cmd-note-width 1
 "Number of columns consumed by the cmd-note field in `mh-scan-format'.
 This column will have one of the values: ` ', `D', `^', `+' and where
 t))
 ;; Fontifify unseen mesages in bold.
-(defvar mh-folder-unseen-seq-name nil
-"Name of unseen sequence.
-The default for this is provided by the function `mh-folder-unseen-seq-name'
-On nmh systems.")
-(defun mh-folder-unseen-seq-name ()
-"Provide name of unseen sequence from mhparam."
-(or mh-progs (mh-find-path))
-(save-excursion
-(let ((unseen-seq-name "unseen"))
-(with-temp-buffer
-(unwind-protect
-(progn
-(call-process (expand-file-name "mhparam" mh-progs)
-nil '(t t) nil "-component" "Unseen-Sequence")
-(goto-char (point-min))
-(if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
-(setq unseen-seq-name (match-string 1))))))
-unseen-seq-name)))
-(defun mh-folder-unseen-seq-list ()
-"Return a list of unseen message numbers for current folder."
-(if (not mh-folder-unseen-seq-name)
-(setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
-(cond
-((not mh-folder-unseen-seq-name)
-nil)
-(t
-(let ((folder mh-current-folder))
-(save-excursion
-(with-temp-buffer
-(unwind-protect
-(progn
-(call-process (expand-file-name "mark" mh-progs)
-nil '(t t) nil
-folder "-seq" mh-folder-unseen-seq-name
-"-list")
-(goto-char (point-min))
-(sort (mh-read-msg-list) '<)))))))))
 (defmacro mh-generate-sequence-font-lock (seq prefix face)
 "Generate the appropriate code to fontify messages in SEQ.
 PREFIX is used to generate unique names for the variables and functions
 defined by the macro. So a different prefix should be provided for every
 (defvar mh-sequence-notation-history nil)
 ;Rememeber original notation that
 ;is overwritten by `mh-note-seq'.
+(defvar mh-colors-available-flag nil)   ;Are colors available?
 ;;; Macros and generic functions:
 (defun mh-mapc (function list)
 "Apply FUNCTION to each element of LIST for side effects only."
 (while list
 (setq list (cdr list))))
 (defun mh-scan-format ()
 "Return the output format argument for the scan program."
 (if (equal mh-scan-format-file t)
-(list "-format" (if mh-nmh-flag
+(list "-format" (if (mh-variant-p 'nmh 'mu-mh)
 (list (mh-update-scan-format
 mh-scan-format-nmh mh-cmd-note))
 (list (mh-update-scan-format
 mh-scan-format-mh mh-cmd-note))))
 (if (not (equal mh-scan-format-file nil))
 ;;;###autoload
 (defun mh-rmail (&optional arg)
 "Inc(orporate) new mail with MH.
 Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
-the Emacs front end to the MH mail system."
+the Emacs interface to the MH mail system."
 (interactive "P")
 (mh-find-path)
 (if arg
 (call-interactively 'mh-visit-folder)
 (unless (get-buffer mh-inbox)
 ;;;###autoload
 (defun mh-nmail (&optional arg)
 "Check for new mail in inbox folder.
 Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
-the Emacs front end to the MH mail system."
+the Emacs interface to the MH mail system."
 (interactive "P")
 (mh-find-path)                        ; init mh-inbox
 (if arg
 (call-interactively 'mh-visit-folder)
 (mh-visit-folder mh-inbox)))
 (mh-prompt-for-folder "inc mail into" mh-inbox t))))
 (if (not folder)
 (setq folder mh-inbox))
 (let ((threading-needed-flag nil))
 (let ((config (current-window-configuration)))
+(delete-other-windows)
 (cond ((not (get-buffer folder))
 (mh-make-folder folder)
 (setq threading-needed-flag mh-show-threads-flag)
 (setq mh-previous-window-config config))
 ((not (eq (current-buffer) (get-buffer folder)))
 (t (forward-line -1)
 (message "No more undeleted messages")
 (if wait-after-complaining-flag (sit-for 1)))))
 (defun mh-folder-from-address ()
-"Determine folder name from address in From field.
+"Derive folder name from sender.
-Takes the address in the From: header field, and returns one of:
+The name of the folder is derived as follows:
-a) The folder name associated with the address in the alist
-`mh-default-folder-list'.  If the `Check Recipient' boolean
+a) The folder name associated with the first address found in the list
-is set, then the `mh-default-folder-list' addresses are
+`mh-default-folder-list' is used. Each element in this list contains a
-checked against the recipient instead of the originator
+`Check Recipient' item. If this item is turned on, then the address is
-(making possible to use this feature for mailing lists).
+checked against the recipient instead of the sender. This is useful for
-The first match found in `mh-default-folder-list' is used.
+mailing lists.
-b) The address' corresponding alias from the user's personal
+b) An alias prefixed by `mh-default-folder-prefix' corresponding to the
-aliases file prefixed by `mh-default-folder-prefix'.
+address is used. The prefix is used to prevent clutter in your mail
+directory.
-Returns nil if the address was not found in either place or if the variable
-`mh-default-folder-must-exist-flag' is nil and the folder does not exist."
+Return nil if a folder name was not derived, or if the variable
+`mh-default-folder-must-exist-flag' is t and the folder does not exist."
 ;; Loop for all entries in mh-default-folder-list
 (save-restriction
 (goto-char (point-min))
-(re-search-forward "\n\n" nil t)
+(re-search-forward "\n\n" nil 'limit)
 (narrow-to-region (point-min) (point))
 (let ((to/cc (concat (or (message-fetch-field "to") "") ", "
 (or (message-fetch-field "cc") "")))
 (from (or (message-fetch-field "from") ""))
 folder-name)
 (defun mh-prompt-for-refile-folder ()
 "Prompt the user for a folder in which the message should be filed.
 The folder is returned as a string.
-If `mh-default-folder-for-message-function' is a function then the message
+The default folder name is generated by the option
-being refiled is yanked into a temporary buffer and the function is called to
+`mh-default-folder-for-message-function' if it is non-nil or
-intelligently guess where the message is to be refiled.
+`mh-folder-from-address'."
-Otherwise, a default folder name is generated by `mh-folder-from-address'."
 (mh-prompt-for-folder
 "Destination"
-(let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
+(let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
-(save-excursion
+(if (null refile-file) ""
-(set-buffer (get-buffer-create mh-temp-buffer))
+(save-excursion
-(erase-buffer)
+(set-buffer (get-buffer-create mh-temp-buffer))
-(insert-file-contents refile-file)
+(erase-buffer)
-(or (and mh-default-folder-for-message-function
+(insert-file-contents refile-file)
-(let ((buffer-file-name refile-file))
+(or (and mh-default-folder-for-message-function
-(funcall mh-default-folder-for-message-function)))
+(let ((buffer-file-name refile-file))
-(mh-folder-from-address)
+(funcall mh-default-folder-for-message-function)))
-(and (eq 'refile (car mh-last-destination-folder))
+(mh-folder-from-address)
-(symbol-name (cdr mh-last-destination-folder)))
+(and (eq 'refile (car mh-last-destination-folder))
-"")))
+(symbol-name (cdr mh-last-destination-folder)))
+""))))
 t))
 (defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
 "Refile RANGE into FOLDER.
 (while (> count 0)
 (setq unread-sequence (cdr unread-sequence))
 (setq count (1- count)))
 (not (car unread-sequence)))
 (message "No more unread messages"))
-(t (mh-goto-msg (car unread-sequence))))))
+(t (loop for msg in unread-sequence
+when (mh-goto-msg msg t) return nil
+finally (message "No more unread messages"))))))
 (defun mh-goto-next-button (backward-flag &optional criterion)
 "Search for next button satisfying criterion.
 If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If
 CRITERION is a function or a symbol which has a function binding then that
 (t (mh-iterate-on-range () range
 (mh-undo-msg nil))))
 (if (not (mh-outstanding-commands-p))
 (mh-set-folder-modified-p nil)))
-;;;###mh-autoload
 (defun mh-folder-line-matches-show-buffer-p ()
 "Return t if the message under point in folder-mode is in the show buffer.
 Return nil in any other circumstance (no message under point, no show buffer,
 the message in the show buffer doesn't match."
 (and (eq major-mode 'mh-folder-mode)
 ;;;###autoload
 (defun mh-version ()
 "Display version information about MH-E and the MH mail handling system."
 (interactive)
-(mh-find-progs)
 (set-buffer (get-buffer-create mh-info-buffer))
 (erase-buffer)
 ;; MH-E version.
 (insert "MH-E " mh-version "\n\n")
 ;; MH-E compilation details.
 " Gnus (compile-time):\t" gnus-compiled-version "\n"
 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
 ;; Emacs version.
 (insert (emacs-version) "\n\n")
 ;; MH version.
-(let ((help-start (point)))
+(if mh-variant-in-use
-(condition-case err-data
+(insert mh-variant-in-use "\n"
-(mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
+" mh-progs:\t" mh-progs "\n"
-(file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
+" mh-lib:\t" mh-lib "\n"
-(goto-char help-start)
+" mh-lib-progs:\t" mh-lib-progs "\n\n")
-(if mh-nmh-flag
+(insert "No MH variant detected\n"))
-(search-forward "inc -- " nil t)
-(search-forward "version: " nil t))
-(delete-region help-start (point)))
-(goto-char (point-max))
-(insert " mh-progs:\t" mh-progs "\n"
-" mh-lib:\t" mh-lib "\n"
-" mh-lib-progs:\t" mh-lib-progs "\n\n")
 ;; Linux version.
 (condition-case ()
 (call-process "uname" nil t nil "-a")
 (file-error))
 (goto-char (point-min))
 (values 0 u folder)))))
 (defun mh-folder-size-flist (folder)
 "Find size of FOLDER using `flist'."
 (with-temp-buffer
-(call-process (expand-file-name "flist" mh-progs) nil t nil
+(call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
 (goto-char (point-min))
 (multiple-value-bind (folder unseen total)
 (mh-parse-flist-output-line
 (buffer-substring (point) (line-end-position)))
 current-prefix-arg
 mh-interpret-number-as-range-flag))))
 (let ((config (current-window-configuration))
 (current-buffer (current-buffer))
 (threaded-view-flag mh-show-threads-flag))
+(delete-other-windows)
 (save-excursion
 (when (get-buffer folder)
 (set-buffer folder)
 (setq threaded-view-flag (memq 'unthread mh-view-ops))))
 (when index-data
 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
 nil))))
 (mh-toggle-threads))
 (mh-index-data
 (mh-index-insert-folder-headers)))
-(unless mh-showing-mode (delete-other-windows))
 (unless (eq current-buffer (current-buffer))
 (setq mh-previous-window-config config)))
 nil)
-;;;###mh-autoload
 (defun mh-update-sequences ()
 "Update MH's Unseen-Sequence and current folder and message.
 Flush MH-E's state out to MH. The message at the cursor becomes current."
 (interactive)
 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
 (format "Message %d already refiled.  Copy to %s as well? "
 msg folder))
 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
 "-src" mh-current-folder
 (symbol-name folder))
-(message "Message not copied.")))
+(message "Message not copied")))
 (t
 (mh-set-folder-modified-p t)
 (cond ((null (assoc folder mh-refile-list))
 (push (list folder msg) mh-refile-list))
 ((not (member msg (cdr (assoc folder mh-refile-list))))
 (while (> count 0)
 (setq unread-sequence (cdr unread-sequence))
 (setq count (1- count)))
 (not (car unread-sequence)))
 (message "No more unread messages"))
-(t (mh-goto-msg (car unread-sequence))))))
+(t (loop for msg in unread-sequence
+when (mh-goto-msg msg t) return nil
+finally (message "No more unread messages"))))))
 (defun mh-set-scan-mode ()
 "Display the scan listing buffer, but do not show a message."
 (if (get-buffer mh-show-buffer)
 (delete-windows-on mh-show-buffer))
 ["Next Message"                     mh-next-undeleted-msg t]
 ["Previous Message"                 mh-previous-undeleted-msg t]
 ["Go to First Message"              mh-first-msg t]
 ["Go to Last Message"               mh-last-msg t]
 ["Go to Message by Number..."       mh-goto-msg t]
-["Modify Message"                   mh-modify]
+["Modify Message"                   mh-modify t]
 ["Delete Message"                   mh-delete-msg (mh-get-msg-num nil)]
 ["Refile Message"                   mh-refile-msg (mh-get-msg-num nil)]
-["Undo Delete/Refile"               mh-undo t]
+["Undo Delete/Refile"               mh-undo (mh-outstanding-commands-p)]
-["Process Delete/Refile"            mh-execute-commands
+["Execute Delete/Refile"            mh-execute-commands
-(or mh-refile-list mh-delete-list)]
+(mh-outstanding-commands-p)]
 "--"
 ["Compose a New Message"            mh-send t]
 ["Reply to Message..."              mh-reply (mh-get-msg-num nil)]
 ["Forward Message..."               mh-forward (mh-get-msg-num nil)]
 ["Redistribute Message..."          mh-redistribute (mh-get-msg-num nil)]
 mh-folder-folder-menu mh-folder-mode-map  "Menu for MH-E folder."
 '("Folder"
 ["Incorporate New Mail"             mh-inc-folder t]
 ["Toggle Show/Folder"               mh-toggle-showing t]
 ["Execute Delete/Refile"            mh-execute-commands
-(or mh-refile-list mh-delete-list)]
+(mh-outstanding-commands-p)]
 ["Rescan Folder"                    mh-rescan-folder t]
 ["Thread Folder"                    mh-toggle-threads
 (not (memq 'unthread mh-view-ops))]
 ["Pack Folder"                      mh-pack-folder t]
 ["Sort Folder"                      mh-sort-folder t]
 (eval-when-compile
 (defvar tool-bar-mode)
 (defvar tool-bar-map)
 (defvar desktop-save-buffer))         ;Emacs 21.4
+;; Register mh-folder-mode as supporting which-function-mode...
+(load "which-func" t t)
+(when (and (boundp 'which-func-modes)
+(not (member 'mh-folder-mode which-func-modes)))
+(push 'mh-folder-mode which-func-modes))
 (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
 You can show the message the cursor is pointing to, and step through the
 messages.  Messages can be marked for deletion or refiling into another
 folder; these commands are executed all at once with a separate command.
-A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
-applies the action to a message sequence. If `transient-mark-mode',
-is non-nil, the action is applied to the region.
 Options that control this mode can be changed with \\[customize-group];
 specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
 option if you wish to modify scan's format.
 When a folder is visited, the hook `mh-folder-mode-hook' is run.
+Ranges
+======
+Many commands that operate on individual messages, such as `mh-forward' or
+`mh-refile-msg' take a RANGE argument. This argument can be used in several
+ways.
+If you provide the prefix argument (\\[universal-argument]) to these commands,
+then you will be prompted for the message range. This can be any legal MH
+range which can include messages, sequences, and the abbreviations (described
+in the mh(1) man page):
+<num1>-<num2>
+Indicates all messages in the range <num1> to <num2>, inclusive. The range
+must be nonempty.
+`<num>:N'
+`<num>:+N'
+`<num>:-N'
+Up to N messages beginning with (or ending with) message num. Num may be
+any of the pre-defined symbols: first, prev, cur, next or last.
+`first:N'
+`prev:N'
+`next:N'
+`last:N'
+The first, previous, next or last messages, if they exist.
+`all'
+All of the messages.
+For example, a range that shows all of these things is `1 2 3 5-10 last:5
+unseen'.
+If the option `transient-mark-mode' is set to t and you set a region in the
+MH-Folder buffer, then the MH-E command will perform the operation on all
+messages in that region.
 \\{mh-folder-mode-map}"
 (make-local-variable 'font-lock-defaults)
 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
 (make-local-variable 'desktop-save-buffer)
 (setq desktop-save-buffer t)
 (mh-make-local-vars
+'mh-colors-available-flag (mh-colors-available-p)
+; Do we have colors available
 'mh-current-folder (buffer-name)     ; Name of folder, a string
 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
 'mh-folder-filename                  ; e.g. "/usr/foobar/Mail/inbox/"
 (file-name-as-directory (mh-expand-file-name (buffer-name)))
+'mh-display-buttons-for-inline-parts-flag
+mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
+; be  toggled.
 'mh-arrow-marker (make-marker)       ; Marker where arrow is displayed
 'overlay-arrow-position nil          ; Allow for simultaneous display in
 'overlay-arrow-string ">"            ;  different MH-E buffers.
 'mh-showing-mode nil                 ; Show message also?
 'mh-delete-list nil                  ; List of msgs nums to delete
 'mh-msg-count nil                    ; Number of msgs in buffer
 'mh-mode-line-annotation nil         ; Indicates message range
 'mh-sequence-notation-history (make-hash-table)
 ; Remember what is overwritten by
 ; mh-note-seq.
+'imenu-create-index-function 'mh-index-create-imenu-index
+; Setup imenu support
 'mh-previous-window-config nil)      ; Previous window configuration
 (mh-remove-xemacs-horizontal-scrollbar)
 (setq truncate-lines t)
 (auto-save-mode -1)
 (setq buffer-offer-save t)
 (mh-funcall-if-exists mh-toolbar-init :folder)
 (if (and mh-xemacs-flag
 font-lock-auto-fontify)
 (turn-on-font-lock)))             ; Force font-lock in XEmacs.
+(defun mh-toggle-mime-buttons ()
+"Toggle display of buttons for inline MIME parts."
+(interactive)
+(setq mh-display-buttons-for-inline-parts-flag
+(not mh-display-buttons-for-inline-parts-flag))
+(mh-show nil t))
+(defun mh-colors-available-p ()
+"Check if colors are available in the Emacs being used."
+(or mh-xemacs-flag
+(let ((color-cells
+(or (ignore-errors (mh-funcall-if-exists display-color-cells))
+(ignore-errors (mh-funcall-if-exists
+x-display-color-cells)))))
+(and (numberp color-cells) (>= color-cells 8)))))
+(defun mh-colors-in-use-p ()
+"Check if colors are being used in the folder buffer."
+(and mh-colors-available-flag font-lock-mode))
 (defun mh-make-local-vars (&rest pairs)
 "Initialize local variables according to the variable-value PAIRS."
 (while pairs
 (set (make-local-variable (car pairs)) (car (cdr pairs)))
 ;;;###autoload
 (defun mh-restore-desktop-buffer (desktop-buffer-file-name
 desktop-buffer-name
 desktop-buffer-misc)
-"Restore an MH folder buffer specified in a desktop file."
+"Restore an MH folder buffer specified in a desktop file.
+When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the file name to
+visit, DESKTOP-BUFFER-NAME holds the desired buffer name, and
+DESKTOP-BUFFER-MISC holds a list of miscellaneous info used by the
+`desktop-buffer-handlers' functions."
 (mh-find-path)
 (mh-visit-folder desktop-buffer-name)
 (current-buffer))
 (defun mh-scan-folder (folder range &optional dont-exec-pending)
 "Scan the FOLDER over the RANGE.
 If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
 refiles aren't carried out.
 Return in the folder's buffer."
+(when (stringp range)
+(setq range (delete "" (split-string range "[ \t\n]"))))
 (cond ((null (get-buffer folder))
 (mh-make-folder folder))
 (t
 (unless dont-exec-pending
 (mh-process-or-undo-commands folder)
 "-width" (window-width)
 folder range)
 (goto-char scan-start)
 (cond ((looking-at "scan: no messages in")
 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
-((looking-at "scan: bad message list ")
+((looking-at (if (mh-variant-p 'mu-mh)
+"scan: message set .* does not exist"
+"scan: bad message list "))
 (keep-lines mh-scan-valid-regexp))
 ((looking-at "scan: "))     ; Keep error messages
 (t
 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
 (setq mh-seq-list (mh-read-folder-sequences folder nil))
 (mh-first-msg-num
 (format " (%d)" mh-first-msg-num))
 (""))))))
 (mh-logo-display))))
-;;; XXX: Remove this function, if no one uses it any more...
-(defun mh-unmark-all-headers (remove-all-flags)
-"Remove all '+' flags from the folder listing.
-With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
-Optimized for speed (i.e., no regular expressions).
-This function is deprecated. Use `mh-remove-all-notation' instead."
-(save-excursion
-(let ((case-fold-search nil)
-(last-line (1- (point-max)))
-char)
-(mh-first-msg)
-(while (<= (point) last-line)
-(forward-char mh-cmd-note)
-(setq char (following-char))
-(if (or (and remove-all-flags
-(or (= char (aref mh-note-deleted 0))
-(= char (aref mh-note-refiled 0))))
-(= char (aref mh-note-cur 0)))
-(progn
-(delete-char 1)
-(insert " ")))
-(if remove-all-flags
-(progn
-(forward-char 1)
-(if (= (following-char) (aref mh-note-seq 0))
-(progn
-(delete-char 1)
-(insert " ")))))
-(forward-line)))))
 (defun mh-add-sequence-notation (msg internal-seq-flag)
 "Add sequence notation to the MSG on the current line.
-If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the
+If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if font-lock is
-current line, so that font-lock would automatically refontify it."
+turned on."
 (with-mh-folder-updating (t)
 (save-excursion
 (beginning-of-line)
 (if internal-seq-flag
-(mh-notate nil nil mh-cmd-note)
+(progn
+;; Change the buffer so that if transient-mark-mode is active
+;; and there is an active region it will get deactivated as in
+;; the case of user sequences.
+(mh-notate nil nil mh-cmd-note)
+(when font-lock-mode
+(font-lock-fontify-region (point) (line-end-position))))
 (forward-char (1+ mh-cmd-note))
 (let ((stack (gethash msg mh-sequence-notation-history)))
 (setf (gethash msg mh-sequence-notation-history)
 (cons (char-after) stack)))
 (mh-notate nil mh-note-seq (1+ mh-cmd-note))))))
 ;; ... and this takes care of user sequences.
 (let ((stack (gethash msg mh-sequence-notation-history)))
 (while (and all (cdr stack))
 (setq stack (cdr stack)))
 (when stack
-(mh-notate nil (car stack) (1+ mh-cmd-note)))
+(save-excursion
+(beginning-of-line)
+(forward-char (1+ mh-cmd-note))
+(delete-char 1)
+(insert (car stack))))
 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
 (defun mh-remove-cur-notation ()
 "Remove old cur notation."
 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
 (mh-iterate-on-range msg (cons (point-min) (point-max))
 (mh-notate nil ?  mh-cmd-note)
 (mh-remove-sequence-notation msg nil t))
 (clrhash mh-sequence-notation-history)))
-;;;###mh-autoload
 (defun mh-goto-cur-msg (&optional minimal-changes-flag)
 "Position the cursor at the current message.
 When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
 recenter the folder buffer."
 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
 (mh-delete-line 1))
 (setq msgs (cdr msgs)))))
 (defun mh-outstanding-commands-p ()
 "Return non-nil if there are outstanding deletes or refiles."
-(or mh-delete-list mh-refile-list))
+(save-excursion
+(when (eq major-mode 'mh-show-mode)
+(set-buffer mh-show-folder-buffer))
+(or mh-delete-list mh-refile-list)))
 (defun mh-coalesce-msg-list (messages)
 "Given a list of MESSAGES, return a list of message number ranges.
 This is the inverse of `mh-read-msg-list', which expands ranges.
 Message lists passed to MH programs should be processed by this function
 (defun mh-internal-seq (name)
 "Return non-nil if NAME is the name of an internal MH-E sequence."
 (or (memq name mh-internal-seqs)
 (eq name mh-unseen-seq)
-(and mh-tick-seq (eq name mh-tick-seq))
+(and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
 (eq name mh-previous-seq)
 (mh-folder-name-p name)))
 (defun mh-valid-seq-p (name)
 "Return non-nil if NAME is a valid MH sequence name."
 (append folders-changed
 (mh-index-delete-from-sequence sequence msg-list))))
 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
 (apply #'mh-speed-flists t folders-changed)))))
+(defun mh-catchup (range)
+"Delete RANGE from the `mh-unseen-seq' sequence.
+Check the document of `mh-interactive-range' to see how RANGE is read in
+interactive use."
+(interactive (list (mh-interactive-range "Catchup"
+(cons (point-min) (point-max)))))
+(mh-delete-msg-from-seq range mh-unseen-seq))
 (defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
 "Delete MSG from SEQUENCE.
 If INTERNAL-FLAG is non-nil, then do not inform MH of the change."
 (let ((entry (mh-find-seq sequence)))
 (when (and entry (memq msg (mh-seq-msgs entry)))
 (not (mh-folder-name-p seq)))
 (save-excursion
 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
 "-sequence" (symbol-name seq)
 (mh-coalesce-msg-list msgs)))))
-(defun mh-map-over-seqs (function seq-list)
-"Apply FUNCTION to each sequence in SEQ-LIST.
-The sequence name and the list of messages are passed as arguments."
-(while seq-list
-(funcall function
-(mh-seq-name (car seq-list))
-(mh-seq-msgs (car seq-list)))
-(setq seq-list (cdr seq-list))))
-(defun mh-notate-if-in-one-seq (msg character offset seq)
-"Notate MSG.
-The CHARACTER is placed at the given OFFSET from the beginning of the listing.
-The notation is performed if the MSG is only in SEQ."
-(let ((in-seqs (mh-seq-containing-msg msg nil)))
-(if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
-(mh-notate msg character offset))))
 (defun mh-seq-containing-msg (msg &optional include-internal-flag)
 "Return a list of the sequences containing MSG.
 If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
 (let ((l mh-seq-list)
 " "           mh-page-msg
 "!"           mh-refile-or-write-again
 "'"           mh-toggle-tick
 ","           mh-header-display
 "."           mh-alt-show
+";"           mh-toggle-mh-decode-mime-flag
 ">"           mh-write-msg-to-file
 "?"           mh-help
 "E"           mh-extract-rejected-mail
 "M"           mh-modify
 "\177"        mh-previous-page
 "e"           mh-edit-again
 "f"           mh-forward
 "g"           mh-goto-msg
 "i"           mh-inc-folder
 "k"           mh-delete-subject-or-thread
-"l"           mh-print-msg
 "m"           mh-alt-send
 "n"           mh-next-undeleted-msg
 "\M-n"        mh-next-unread-msg
 "o"           mh-refile-msg
 "p"           mh-previous-undeleted-msg
 (gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
 "?"           mh-prefix-help
 "'"           mh-index-ticked-messages
 "S"           mh-sort-folder
+"c"           mh-catchup
 "f"           mh-alt-visit-folder
 "i"           mh-index-search
 "k"           mh-kill-folder
 "l"           mh-list-folders
 "n"           mh-index-new-messages
 (gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
 "?"           mh-prefix-help
 "b"           mh-junk-blacklist
 "w"           mh-junk-whitelist)
+(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
+"?"           mh-prefix-help
+"A"           mh-ps-print-toggle-mime
+"C"           mh-ps-print-toggle-color
+"F"           mh-ps-print-toggle-faces
+"M"           mh-ps-print-toggle-mime
+"f"           mh-ps-print-msg-file
+"l"		mh-print-msg
+"p"           mh-ps-print-msg
+"s"           mh-ps-print-msg-show)
 (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
 "'"           mh-narrow-to-tick
 "?"           mh-prefix-help
 "d"           mh-delete-msg-from-seq
 "k"           mh-delete-seq
 "b"           mh-burst-digest)
 (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
 "?"           mh-prefix-help
 "a"           mh-mime-save-parts
+"e"           mh-display-with-external-viewer
 "i"           mh-folder-inline-mime-part
 "o"           mh-folder-save-mime-part
+"t"           mh-toggle-mime-buttons
 "v"           mh-folder-toggle-mime-part
 "\t"          mh-next-button
 [backtab]     mh-prev-button
 "\M-\t"       mh-prev-button)
 ;;; prefix is for. For example, if the word "folder" were not present in the
 ;;; `F' entry, it would not be clear what these commands operated upon.
 (defvar mh-help-messages
 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
 "[d]elete, [o]refile, e[x]ecute,\n"
-"[s]end, [r]eply.\n"
+"[s]end, [r]eply,\n"
+"[;]toggle MIME decoding.\n"
 "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys,"
 "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
 (?F "[l]ist; [v]isit folder;\n"
 "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n"
 "[p]ack; [S]ort; [r]escan; [k]ill")
+(?P "PS [p]rint message; [l]non-PS print;\n"
+"PS Print [s]how window, message to [f]ile;\n"
+"Toggle printing of [M]IME parts, [C]olor, [F]aces")
 (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n"
 "[s]equences, [l]ist,\n"
 "[d]elete message from sequence, [k]ill sequence")
 (?T "[t]oggle, [d]elete, [o]refile thread")
 (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")

Mercurial > emacs

comparison lisp/mh-e/mh-e.el @ 89966:d8411455de48