;;; mh-e.el --- GNU Emacs interface to the MH mail system
;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999,
-;; 2000, 01, 02, 2003 Free Software Foundation, Inc.
+;; 2000, 2005 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 7.3+cvs
+;; Version: 7.82
;; Keywords: mail
;; This file is part of GNU Emacs.
;; 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
-;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
-;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
-;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
+;; Rewritten for GNU Emacs, James Larus, 1985.
+;; Modified by Stephen Gildea, 1988.
+;; Maintenance picked up by Bill Wohler and the
+;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001.
;;; Code:
-(require 'cl)
-
-(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)))
+(provide 'mh-e)
-(require 'mh-inc)
+(eval-when-compile (require 'mh-acros))
+(mh-require-cl)
(require 'mh-utils)
+(require 'mh-init)
+(require 'mh-inc)
+(require 'mh-seq)
(require 'gnus-util)
(require 'easymenu)
-(if mh-xemacs-flag
- (require 'mh-xemacs-compat))
;; Shush the byte-compiler
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
-(defconst mh-version "7.3+cvs" "Version number of MH-E.")
+(defconst mh-version "7.82" "Version number of MH-E.")
;;; Autoloads
(autoload 'Info-goto-node "info")
-\f
-
-(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.")
+\f
+;;; 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
-;; setting of `mh-scan-format-file' above is nil. They are identical
-;; except the later one makes use of the nmh `decode' function to
-;; decode RFC 2047 encodings. If you just want to change the width of
-;; the msg number, use the `mh-set-cmd-note' function.
+;; The following scan formats are passed to the scan program if the setting of
+;; `mh-scan-format-file' is t. They are identical except the later one makes
+;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just
+;; want to change the width of the msg number, use the `mh-set-cmd-note'
+;; function.
(defvar mh-scan-format-mh
(concat
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
-message has been replied to, t if an address on the To: line matches
-one of the mailboxes of the current user, `c' if the Cc: line matches,
-`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
-is present.")
+The values of the fifth column, in priority order, are: `-' if the message has
+been replied to, t if an address on the To: line matches one of the
+mailboxes of the current user, `c' if the Cc: line matches, `b' if the Bcc:
+line matches, and `n' if a non-empty Newsgroups: header is present.")
(defvar mh-scan-format-nmh
(concat
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
-message has been replied to, t if an address on the To: line matches
-one of the mailboxes of the current user, `c' if the Cc: line matches,
-`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
-is present.")
+The values of the fifth column, in priority order, are: `-' if the message has
+been replied to, t if an address on the To: field matches one of the
+mailboxes of the current user, `c' if the Cc: field matches, `b' if the Bcc:
+field matches, and `n' if a non-empty Newsgroups: field 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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.")
+ "This regexp specifies the scan lines that are 'good' messages.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.")
+ "This regexp matches deleted messages.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.")
+ "This regexp matches refiled messages.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the message number.
-Don't disable this regexp as it's needed by non fontifying functions.")
-
-(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
- "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.")
+ "This regexp matches the current message.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+expression to contain at least one parenthesized expression which matches the
+message number as in the default of \"^\\\\( *[0-9]+\\\\+\\\\).*\". Don't
+disable this regexp as it's needed by non-fontifying functions.
+See also `mh-note-cur'.")
(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
- "Regexp matching a valid date in scan lines.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-only one parenthesized expression which matches the date field
-\(see `mh-scan-format-regexp').")
+ "This regexp matches a valid date.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+expression to contain only one parenthesized expression which matches the date
+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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-two parenthesized expressions. The first is expected to match the To:
-that the default scan format file generates. The second is expected to match
-the recipient's name.")
+ "This regexp specifies the recipient in messages you sent.
+Note that the default setting of `mh-folder-font-lock-keywords'
+expects this expression to contain two parenthesized expressions. The
+first is expected to match the `To:' that the default scan format
+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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least one parenthesized expression which matches the body text.")
+ "This regexp matches the message body fragment displayed in scan lines.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+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.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least tree parenthesized expressions. The first is expected to match the Re:
-string, if any. The second matches an optional bracketed number after Re,
-such as in Re[2]: and the third is expected to match the subject line itself.")
+ "This regexp matches the subject.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+expression to contain at least three parenthesized expressions. The first is
+expected to match the `Re:' string, if any. The second matches an optional
+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.
-The default value is based upon the default values of either
-`mh-scan-format-mh' or `mh-scan-format-nmh'.
-The default `mh-folder-font-lock-keywords' expects this expression to contain
-at least three parenthesized expressions. The first should match the
-fontification hint, the second is found in `mh-scan-date-regexp', and the
-third should match the user name.")
+ "This regexp matches the output of scan.
+Note that the default setting of `mh-folder-font-lock-keywords' expects this
+expression to contain at least three parenthesized expressions. The first
+should match the fontification hint, the second is found in
+`mh-scan-date-regexp', and the third should match the user name as in the
+default of \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp
+ \"*\\\\(..................\\\\)\")\".")
\f
;; scan font-lock name
(list mh-scan-format-regexp
'(1 mh-folder-date-face)
- '(3 mh-folder-scan-format-face))
- ;; Current message line
- (list mh-scan-cur-msg-regexp
- '(1 mh-folder-cur-msg-face prepend t))
- ;; Unseen messages in bold
- '(mh-folder-font-lock-unseen (1 'bold append t)))
+ '(3 mh-folder-scan-format-face)))
"Regexp keywords used to fontify the MH-Folder buffer.")
(defvar mh-scan-cmd-note-width 1
;; 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) '<)))))))))
-
-(defvar mh-folder-unseen-seq-cache nil
- "Internal cache variable used for font-lock in MH-E.
+(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
+invocation.
+FACE is the font-lock face used to display the matching scan lines."
+ (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
+ (func (intern (format "mh-folder-font-lock-%s" prefix))))
+ `(progn
+ (defvar ,cache nil
+ "Internal cache variable used for font-lock in MH-E.
Should only be non-nil through font-lock stepping, and nil once font-lock
is done highlighting.")
-(make-variable-buffer-local 'mh-folder-unseen-seq-cache)
-
-(defun mh-folder-font-lock-unseen (limit)
- "Return unseen message lines to font-lock between point and LIMIT."
- (if (not mh-folder-unseen-seq-cache)
- (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
- (let ((cur-msg (mh-get-msg-num nil)))
- (cond
- ((not mh-folder-unseen-seq-cache)
- nil)
- ((>= (point) limit) ;Presumably at end of buffer
- (setq mh-folder-unseen-seq-cache nil)
- nil)
- ((member cur-msg mh-folder-unseen-seq-cache)
- (let ((bpoint (progn (beginning-of-line)(point)))
- (epoint (progn (forward-line 1)(point))))
- (if (<= limit (point))
- (setq mh-folder-unseen-seq-cache nil))
- (set-match-data (list bpoint epoint bpoint epoint))
- t))
- (t
- ;; move forward one line at a time, checking each message number.
- (while (and
- (= 0 (forward-line 1))
- (> limit (point))
- (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
- ;; Examine how we must have exited the loop...
- (let ((cur-msg (mh-get-msg-num nil)))
- (cond
- ((or (<= limit (point))
- (not (member cur-msg mh-folder-unseen-seq-cache)))
- (setq mh-folder-unseen-seq-cache nil)
- nil)
- ((member cur-msg mh-folder-unseen-seq-cache)
- (let ((bpoint (progn (beginning-of-line)(point)))
- (epoint (progn (forward-line 1)(point))))
- (if (<= limit (point))
- (setq mh-folder-unseen-seq-cache nil))
- (set-match-data (list bpoint epoint bpoint epoint))
- t))))))))
+ (make-variable-buffer-local ',cache)
+
+ (defun ,func (limit)
+ "Return unseen message lines to font-lock between point and LIMIT."
+ (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
+ (let ((cur-msg (mh-get-msg-num nil)))
+ (cond ((not ,cache)
+ nil)
+ ((>= (point) limit) ;Presumably at end of buffer
+ (setq ,cache nil)
+ nil)
+ ((member cur-msg ,cache)
+ (let ((bpoint (progn (beginning-of-line)(point)))
+ (epoint (progn (forward-line 1)(point))))
+ (if (<= limit (point)) (setq ,cache nil))
+ (set-match-data (list bpoint epoint bpoint epoint))
+ t))
+ (t
+ ;; move forward one line at a time, checking each message
+ (while (and (= 0 (forward-line 1))
+ (> limit (point))
+ (not (member (mh-get-msg-num nil) ,cache))))
+ ;; Examine how we must have exited the loop...
+ (let ((cur-msg (mh-get-msg-num nil)))
+ (cond ((or (<= limit (point))
+ (not (member cur-msg ,cache)))
+ (setq ,cache nil)
+ nil)
+ ((member cur-msg ,cache)
+ (let ((bpoint (progn (beginning-of-line) (point)))
+ (epoint (progn (forward-line 1) (point))))
+ (if (<= limit (point)) (setq ,cache nil))
+ (set-match-data
+ (list bpoint epoint bpoint epoint))
+ t))))))))
+
+ (setq mh-folder-font-lock-keywords
+ (append mh-folder-font-lock-keywords
+ (list (list ',func (list 1 '',face 'prepend t))))))))
+
+(mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
+(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick-face)
\f
(defvar mh-next-direction 'forward) ;Direction to move to next message.
-(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
- ;nil if not narrowed.
-
-(defvar mh-tick-seq-changed-when-narrowed-flag nil)
- ;Has tick sequence changed while the
- ;folder was narrowed to it?
-
(defvar mh-view-ops ()) ;Stack of ops that change the folder
;view (such as narrowing or threading).
+(defvar mh-folder-view-stack ()) ;Stack of previous folder views.
(defvar mh-index-data nil) ;Info about index search results
(defvar mh-index-previous-search nil)
(defvar mh-index-msg-checksum-map nil)
(defvar mh-index-checksum-origin-map nil)
+(defvar mh-index-sequence-search-flag nil)
(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
+(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)
(setq list (cdr list))))
(defun mh-scan-format ()
- "Return \"-format\" argument for the scan program."
+ "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))
- (list "-format" mh-scan-format-file))))
+ (list "-form" mh-scan-format-file))))
\f
(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
(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
;;; User executable MH-E commands:
-(defun mh-delete-msg (msg-or-seq)
- "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
-Default is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is marked for deletion.
-In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
-region in a cons cell, or a sequence."
- (interactive (list (mh-interactive-msg-or-seq "Delete")))
- (mh-delete-msg-no-motion msg-or-seq)
- (mh-next-msg))
-
-(defun mh-delete-msg-no-motion (msg-or-seq)
- "Mark the specified MSG-OR-SEQ for subsequent deletion.
+(defun mh-delete-msg (range)
+ "Mark the specified RANGE for subsequent deletion and move to the next.
Default is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is marked for deletion.
-In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
-region in a cons cell, or a sequence."
- (interactive (list (mh-interactive-msg-or-seq "Delete")))
- (mh-iterate-on-msg-or-seq () msg-or-seq
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use."
+ (interactive (list (mh-interactive-range "Delete")))
+ (mh-delete-msg-no-motion range)
+ (if (looking-at mh-scan-deleted-msg-regexp) (mh-next-msg)))
+
+(defun mh-delete-msg-no-motion (range)
+ "Mark the specified RANGE for subsequent deletion.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use."
+ (interactive (list (mh-interactive-range "Delete")))
+ (mh-iterate-on-range () range
(mh-delete-a-msg nil)))
(defun mh-execute-commands ()
"Process outstanding delete and refile requests."
(interactive)
- (if mh-narrowed-to-seq (mh-widen))
+ (if mh-folder-view-stack (mh-widen t))
(mh-process-commands mh-current-folder)
(mh-set-scan-mode)
(mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
(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)
(save-excursion
(goto-char (point-min))
(or (null mh-large-folder)
- (not (equal (forward-line mh-large-folder) 0))
+ (not (equal (forward-line (1+ mh-large-folder)) 0))
(and (message "Not threading since the number of messages exceeds `mh-large-folder'")
nil))))
(mh-toggle-threads))
(if wait-after-complaining-flag (sit-for 1)))))
(defun mh-folder-from-address ()
- "Determine folder name from address in From field.
-Takes the address in the From: header field, and returns one of:
+ "Derive folder name from sender.
- a) The folder name associated with the address in the alist
- `mh-default-folder-list'. If the `Check Recipient' boolean
- is set, then the `mh-default-folder-list' addresses are
- checked against the recipient instead of the originator
- (making possible to use this feature for mailing lists).
- The first match found in `mh-default-folder-list' is used.
+The name of the folder is derived as follows:
- b) The address' corresponding alias from the user's personal
- aliases file prefixed by `mh-default-folder-prefix'.
+ a) The folder name associated with the first address found in the list
+ `mh-default-folder-list' is used. Each element in this list contains a
+ `Check Recipient' item. If this item is turned on, then the address is
+ checked against the recipient instead of the sender. This is useful for
+ mailing lists.
-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."
+ b) An alias prefixed by `mh-default-folder-prefix' corresponding to the
+ address is used. The prefix is used to prevent clutter in your mail
+ directory.
+
+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-excursion
- (let ((folder-name
- (car
- (delq nil
- (mapcar
- (lambda (list)
- (let ((address-regexp (nth 0 list))
- (folder (nth 1 list))
- (to-flag (nth 2 list)))
- (when (or
- (mh-goto-header-field (if to-flag "To:" "From:"))
- ; if the To: field is missing, try Cc:
- (and to-flag (mh-goto-header-field "cc:")))
- (let ((endfield (save-excursion
- (mh-header-field-end)(point))))
- (if (re-search-forward address-regexp endfield t)
- folder
- (when to-flag ;Try Cc: as well
- (mh-goto-header-field "cc:")
- (let ((endfield (save-excursion
- (mh-header-field-end)(point))))
- (when (re-search-forward
- address-regexp endfield t)
- folder))))))))
- mh-default-folder-list)))))
+ (save-restriction
+ (goto-char (point-min))
+ (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)
+ (setq folder-name
+ (loop for list in mh-default-folder-list
+ when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
+ return (nth 1 list)
+ finally return nil))
;; Make sure a result from `mh-default-folder-list' begins with "+"
;; since 'mh-expand-file-name below depends on it
"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
-being refiled is yanked into a temporary buffer and the function is called to
-intelligently guess where the message is to be refiled.
-
-Otherwise, a default folder name is generated by `mh-folder-from-address'."
+The default folder name is generated by the option
+`mh-default-folder-for-message-function' if it is non-nil or
+`mh-folder-from-address'."
(mh-prompt-for-folder
"Destination"
- (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
- (save-excursion
- (set-buffer (get-buffer-create mh-temp-buffer))
- (erase-buffer)
- (insert-file-contents refile-file)
- (or (and mh-default-folder-for-message-function
- (let ((buffer-file-name refile-file))
- (funcall mh-default-folder-for-message-function)))
- (mh-folder-from-address)
- (and (eq 'refile (car mh-last-destination-folder))
- (symbol-name (cdr mh-last-destination-folder)))
- "")))
+ (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t)))))
+ (if (null refile-file) ""
+ (save-excursion
+ (set-buffer (get-buffer-create mh-temp-buffer))
+ (erase-buffer)
+ (insert-file-contents refile-file)
+ (or (and mh-default-folder-for-message-function
+ (let ((buffer-file-name refile-file))
+ (funcall mh-default-folder-for-message-function)))
+ (mh-folder-from-address)
+ (and (eq 'refile (car mh-last-destination-folder))
+ (symbol-name (cdr mh-last-destination-folder)))
+ ""))))
t))
-(defun mh-refile-msg (msg-or-seq folder
- &optional dont-update-last-destination-flag)
- "Refile MSG-OR-SEQ into FOLDER.
-Default is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is marked for refiling.
-In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
-region in a cons cell, or a sequence.
+(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag)
+ "Refile RANGE into FOLDER.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use.
If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the
variables `mh-last-destination' and `mh-last-destination-folder' are not
updated."
- (interactive (list (mh-interactive-msg-or-seq "Refile")
+ (interactive (list (mh-interactive-range "Refile")
(intern (mh-prompt-for-refile-folder))))
(unless dont-update-last-destination-flag
(setq mh-last-destination (cons 'refile folder)
mh-last-destination-folder mh-last-destination))
- (mh-iterate-on-msg-or-seq () msg-or-seq
+ (mh-iterate-on-range () range
(mh-refile-a-msg nil folder))
- (mh-next-msg))
+ (when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg)))
(defun mh-refile-or-write-again (message)
"Re-execute the last refile or write command on the given MESSAGE.
(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.
(when (consp part-index) (setq part-index (car part-index)))
(mh-folder-mime-action part-index #'mh-mime-save-part nil))
+(defvar mh-thread-scan-line-map-stack)
+
(defun mh-reset-threads-and-narrowing ()
"Reset all variables pertaining to threads and narrowing.
Also removes all content from the folder buffer."
(setq mh-view-ops ())
- (setq mh-narrowed-to-seq nil)
+ (setq mh-folder-view-stack ())
+ (setq mh-thread-scan-line-map-stack ())
(let ((buffer-read-only nil)) (erase-buffer)))
(defun mh-rescan-folder (&optional range dont-exec-pending)
If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
refiles aren't carried out."
(interactive (list (if current-prefix-arg
- (mh-read-msg-range mh-current-folder t)
+ (mh-read-range "Rescan" mh-current-folder t nil t
+ mh-interpret-number-as-range-flag)
nil)))
(setq mh-next-direction 'forward)
(let ((threaded-flag (memq 'unthread mh-view-ops)))
(mh-set-scan-mode)
(mh-show)))
-(defun mh-undo (msg-or-seq)
- "Undo the pending deletion or refile of the specified MSG-OR-SEQ.
-Default is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is unmarked.
-In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
-region in a cons cell, or a sequence."
- (interactive (list (mh-interactive-msg-or-seq "Undo")))
- (cond ((numberp msg-or-seq)
+(defun mh-undo (range)
+ "Undo the pending deletion or refile of the specified RANGE.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use."
+ (interactive (list (mh-interactive-range "Undo")))
+ (cond ((numberp range)
(let ((original-position (point)))
(beginning-of-line)
(while (not (or (looking-at mh-scan-deleted-msg-regexp)
(mh-maybe-show))
(goto-char original-position)
(error "Nothing to undo"))))
- (t (mh-iterate-on-msg-or-seq () msg-or-seq
+ (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,
(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.
;; Emacs version.
(insert (emacs-version) "\n\n")
;; MH version.
- (let ((help-start (point)))
- (condition-case err-data
- (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
- (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
- (goto-char help-start)
- (if mh-nmh-flag
- (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")
+ (if mh-variant-in-use
+ (insert mh-variant-in-use "\n"
+ " mh-progs:\t" mh-progs "\n"
+ " mh-lib:\t" mh-lib "\n"
+ " mh-lib-progs:\t" mh-lib-progs "\n\n")
+ (insert "No MH variant detected\n"))
;; Linux version.
(condition-case ()
(call-process "uname" nil t nil "-a")
(setq folder (substring folder 0 (1- (length folder)))))
(values (format "+%s" folder) (car unseen) (car total))))))))
-(defun mh-folder-size (folder)
- "Find size of FOLDER."
+(defun mh-folder-size-folder (folder)
+ "Find size of FOLDER using `folder'."
+ (with-temp-buffer
+ (let ((u (length (cdr (assoc mh-unseen-seq
+ (mh-read-folder-sequences folder nil))))))
+ (call-process (expand-file-name "folder" mh-progs) nil t nil
+ "-norecurse" folder)
+ (goto-char (point-min))
+ (if (re-search-forward " has \\([0-9]+\\) " nil t)
+ (values (car (read-from-string (match-string 1))) u folder)
+ (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)
(buffer-substring (point) (line-end-position)))
(values total unseen folder))))
+(defun mh-folder-size (folder)
+ "Find size of FOLDER."
+ (if mh-flists-present-flag
+ (mh-folder-size-flist folder)
+ (mh-folder-size-folder folder)))
+
(defun mh-visit-folder (folder &optional range index-data)
"Visit FOLDER and display RANGE of messages.
Do not call this function from outside MH-E; see \\[mh-rmail] instead.
regardless of the size of the `mh-large-folder' variable."
(interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
(list folder-name
- (mh-read-msg-range folder-name current-prefix-arg))))
+ (mh-read-range "Scan" folder-name t nil
+ 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 mh-index-data (car index-data)
mh-index-msg-checksum-map (make-hash-table :test #'equal)
mh-index-checksum-origin-map (make-hash-table :test #'equal))
- (mh-index-update-maps folder (cadr index-data)))
+ (mh-index-update-maps folder (cadr index-data))
+ (mh-index-create-sequences))
(mh-scan-folder folder (or range "all"))
(cond ((and threaded-view-flag
(save-excursion
(goto-char (point-min))
(or (null mh-large-folder)
- (not (equal (forward-line mh-large-folder) 0))
+ (not (equal (forward-line (1+ mh-large-folder)) 0))
(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."
(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))
(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."
;;; The folder data abstraction.
+(defvar mh-index-data-file ".mhe_index"
+ "MH-E specific file where index seach info is stored.")
+
(defun mh-make-folder (name)
"Create a new mail folder called NAME.
Make it the current folder."
(mh-folder-mode)
(mh-set-folder-modified-p nil)
(setq buffer-file-name mh-folder-filename)
+ (when (and (not mh-index-data)
+ (file-exists-p (concat buffer-file-name mh-index-data-file)))
+ (mh-index-read-data))
(mh-make-folder-mode-line))
;;; Ensure new buffers won't get this mode if default-major-mode is nil.
["List Sequences in Folder..." mh-list-sequences t]
["Delete Sequence..." mh-delete-seq t]
["Narrow to Sequence..." mh-narrow-to-seq t]
- ["Widen from Sequence" mh-widen mh-narrowed-to-seq]
+ ["Widen from Sequence" mh-widen mh-folder-view-stack]
"--"
["Narrow to Subject Sequence" mh-narrow-to-subject t]
["Narrow to Tick Sequence" mh-narrow-to-tick
["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]
- ["Process Delete/Refile" mh-execute-commands
- (or mh-refile-list mh-delete-list)]
+ ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)]
+ ["Execute Delete/Refile" mh-execute-commands
+ (mh-outstanding-commands-p)]
"--"
["Compose a New Message" mh-send t]
["Reply to Message..." mh-reply (mh-get-msg-num nil)]
["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))]
(set-specifier horizontal-scrollbar-visible-p nil
(cons (current-buffer) nil)))))
-;; Avoid compiler warnings in XEmacs and GNU Emacs 20
-(eval-when-compile (defvar tool-bar-mode))
-
(defmacro mh-write-file-functions-compat ()
"Return `write-file-functions' if it exists.
Otherwise return `local-write-file-hooks'. This macro exists purely for
''write-file-functions ;Emacs 21.4
''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
-;; Avoid compiler warning
-(defvar tool-bar-map)
+;; Avoid compiler warnings in non-bleeding edge versions of Emacs.
+(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>
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 valid 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-seq-list nil ; Alist of (seq . msgs) nums
'mh-seen-list nil ; List of displayed messages
'mh-next-direction 'forward ; Direction to move to next message
- 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
- 'mh-tick-seq-changed-when-narrowed-flag nil
- ; Tick seq changed while narrowed
'mh-view-ops () ; Stack that keeps track of the order
; in which narrowing/threading has been
; carried out.
+ 'mh-folder-view-stack () ; Stack of previous views of the
+ ; folder.
'mh-index-data nil ; If the folder was created by a call
; to mh-index-search this contains info
; about the search results.
'mh-index-previous-search nil ; Previous folder and search-regexp
'mh-index-msg-checksum-map nil ; msg -> checksum map
'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
+ 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
'mh-first-msg-num nil ; Number of first msg in buffer
'mh-last-msg-num nil ; Number of last msg in buffer
'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)
(easy-menu-add mh-folder-sequence-menu)
(easy-menu-add mh-folder-message-menu)
(easy-menu-add mh-folder-folder-menu)
- (if (and (boundp 'tool-bar-mode) tool-bar-mode)
- (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
+ (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
(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."
(set (make-local-variable (car pairs)) (car (cdr pairs)))
(setq pairs (cdr (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.
+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
(range (if (and range (atom range)) (list range) range))
scan-start)
(message "Scanning %s..." folder)
+ (mh-remove-all-notation)
(with-mh-folder-updating (nil)
(if update
(goto-char (point-max))
(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
(message "inc %s..." folder))
(setq mh-next-direction 'forward)
(goto-char (point-max))
+ (mh-remove-all-notation)
(let ((start-of-inc (point)))
- (mh-remove-cur-notation)
(if maildrop-name
;; I think MH 5 used "-ms-file" instead of "-file",
;; which would make inc'ing from maildrops fail.
(re-search-forward "^inc: no mail" nil t))
(message "No new mail%s%s" (if maildrop-name " in " "")
(if maildrop-name maildrop-name "")))
- ((and (when mh-narrowed-to-seq
+ ((and (when mh-folder-view-stack
(let ((saved-text (buffer-substring-no-properties
start-of-inc (point-max))))
(delete-region start-of-inc (point-max))
- (unwind-protect (mh-widen)
+ (unwind-protect (mh-widen t)
+ (mh-remove-all-notation)
(goto-char (point-max))
(setq start-of-inc (point))
(insert saved-text)
(setq mh-seq-list (mh-read-folder-sequences folder t))
(when (equal (point-max) start-of-inc)
(mh-notate-cur))
- (mh-notate-user-sequences)
(if new-mail-flag
(progn
(mh-make-folder-mode-line)
(when (memq 'unthread mh-view-ops)
(mh-thread-inc folder start-of-inc))
(mh-goto-cur-msg))
- (goto-char point-before-inc))))))
+ (goto-char point-before-inc))
+ (mh-notate-user-sequences)
+ (mh-notate-deleted-and-refiled)))))
(defun mh-make-folder-mode-line (&optional ignored)
"Set the fields of the mode line for a folder buffer.
(""))))))
(mh-logo-display))))
-(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)."
- (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 refontify the scan line if font-lock is
+turned on."
+ (with-mh-folder-updating (t)
+ (save-excursion
+ (beginning-of-line)
+ (if internal-seq-flag
+ (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))))))
+
+(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
+ "Remove sequence notation from the MSG on the current line.
+If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the
+sequence. In that case, no notation needs to be removed. Otherwise the effect
+of inserting `mh-note-seq' needs to be reversed.
+If ALL is non-nil, then all sequence marks on the scan line are removed."
+ (with-mh-folder-updating (t)
+ ;; This takes care of internal sequences...
+ (mh-notate nil nil mh-cmd-note)
+ (unless internal-seq-flag
+ ;; ... 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
+ (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."
(save-excursion
(setq overlay-arrow-position nil)
(goto-char (point-min))
- (while (not (eobp))
- (unless (or (equal (char-after) ?+) (eolp))
- (mh-notate nil ? mh-cmd-note)
- (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
- (mh-notate nil ? (1+ mh-cmd-note))))
- (forward-line))))
+ (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
;; Update the unseen sequence if it exists
(mh-update-unseen)
- (let ((redraw-needed-flag mh-index-data))
+ (let ((redraw-needed-flag mh-index-data)
+ (folders-changed (list mh-current-folder))
+ (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag
+ (mh-create-sequence-map mh-seq-list)))
+ (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
+ (make-hash-table))))
;; Remove invalid scan lines if we are in an index folder and then remove
;; the real messages
(when mh-index-data
(mh-index-delete-folder-headers)
- (mh-index-execute-commands))
+ (setq folders-changed
+ (append folders-changed (mh-index-execute-commands))))
;; Then refile messages
(mh-mapc #'(lambda (folder-msg-list)
- (let ((dest-folder (symbol-name (car folder-msg-list)))
- (msgs (cdr folder-msg-list)))
+ (let* ((dest-folder (symbol-name (car folder-msg-list)))
+ (last (car (mh-translate-range dest-folder "last")))
+ (msgs (cdr folder-msg-list)))
+ (push dest-folder folders-changed)
(setq redraw-needed-flag t)
(apply #'mh-exec-cmd
"refile" "-src" folder dest-folder
(mh-coalesce-msg-list msgs))
- (mh-delete-scan-msgs msgs)))
+ (mh-delete-scan-msgs msgs)
+ ;; Preserve sequences in destination folder...
+ (when (and mh-refile-preserves-sequences-flag
+ (numberp last))
+ (clrhash dest-map)
+ (loop for i from (1+ last)
+ for msg in (sort (copy-sequence msgs) #'<)
+ do (loop for seq-name in (gethash msg seq-map)
+ do (push i (gethash seq-name dest-map))))
+ (maphash
+ #'(lambda (seq msgs)
+ ;; Run it in the background, since we don't care
+ ;; about the results.
+ (apply #'mh-exec-cmd-daemon "mark" #'ignore
+ "-sequence" (symbol-name seq) dest-folder
+ "-add" (mapcar #'(lambda (x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
+ dest-map))))
mh-refile-list)
(setq mh-refile-list ())
;; Redraw folder buffer if needed
(when (and redraw-needed-flag)
(when (mh-speed-flists-active-p)
- (mh-speed-flists t mh-current-folder))
+ (apply #'mh-speed-flists t folders-changed))
(cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
(mh-index-data (mh-index-insert-folder-headers)))))
(mh-invalidate-show-buffer))
(setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
- (mh-unmark-all-headers t)
+ (mh-remove-all-notation)
(mh-notate-user-sequences)
(message "Processing deletes and refiles for %s...done" folder)))
(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.
(defun mh-greaterp (msg1 msg2)
"Return the greater of two message indicators MSG1 and MSG2.
Strings are \"smaller\" than numbers.
-Legal values are things like \"cur\", \"last\", 1, and 1820."
+Valid values are things like \"cur\", \"last\", 1, and 1820."
(if (numberp msg1)
(if (numberp msg2)
(> msg1 msg2)
(defun mh-lessp (msg1 msg2)
"Return the lesser of two message indicators MSG1 and MSG2.
Strings are \"smaller\" than numbers.
-Legal values are things like \"cur\", \"last\", 1, and 1820."
+Valid values are things like \"cur\", \"last\", 1, and 1820."
(not (mh-greaterp msg1 msg2)))
\f
(setq msgs (cons num msgs)))))
msgs))
-(defun mh-notate-user-sequences (&optional msg-or-seq)
- "Mark user-defined sequences in the messages specified by MSG-OR-SEQ.
-The optional argument MSG-OR-SEQ can be a message number, a list of message
-numbers, a sequence, a region in a cons cell, or nil in which case all
-messages in the folder buffer are notated."
- (unless msg-or-seq
- (setq msg-or-seq (cons (point-min) (point-max))))
+(defun mh-notate-user-sequences (&optional range)
+ "Mark user-defined sequences in the messages specified by RANGE.
+The optional argument RANGE can be a message number, a list of message
+numbers, a sequence, a region in a cons cell. If nil all messages are notated."
+ (unless range
+ (setq range (cons (point-min) (point-max))))
(let ((seqs mh-seq-list)
- (msg-hash (make-hash-table))
- (tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq)))))
+ (msg-hash (make-hash-table)))
(dolist (seq seqs)
- (unless (mh-internal-seq (mh-seq-name seq))
- (dolist (msg (mh-seq-msgs seq))
- (setf (gethash msg msg-hash) t))))
- (mh-iterate-on-msg-or-seq msg msg-or-seq
- (when (gethash msg msg-hash)
- (mh-notate nil mh-note-seq (1+ mh-cmd-note)))
- (mh-notate-tick msg tick-msgs))))
+ (dolist (msg (mh-seq-msgs seq))
+ (push (car seq) (gethash msg msg-hash))))
+ (mh-iterate-on-range msg range
+ (loop for seq in (gethash msg msg-hash)
+ do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
+
+(defvar mh-internal-seqs '(answered cur deleted forwarded printed))
(defun mh-internal-seq (name)
"Return non-nil if NAME is the name of an internal MH-E sequence."
- (or (memq name '(answered cur deleted forwarded printed))
+ (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-delete-msg-from-seq (msg-or-seq sequence &optional internal-flag)
- "Delete MSG-OR-SEQ from SEQUENCE.
-Default value of MSG-OR-SEQ is the displayed message.
-If optional prefix argument is provided, then prompt for the message sequence.
-If variable `transient-mark-mode' is non-nil and the mark is active, then the
-selected region is deleted from SEQUENCE..
-In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a
-region in a cons cell, or a sequence; optional third arg INTERNAL-FLAG non-nil
-means do not inform MH of the change."
- (interactive (list (mh-interactive-msg-or-seq "Delete")
+(defun mh-valid-seq-p (name)
+ "Return non-nil if NAME is a valid MH sequence name."
+ (and (symbolp name)
+ (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
+
+(defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
+ "Delete RANGE from SEQUENCE.
+
+Check the documentation of `mh-interactive-range' to see how RANGE is read in
+interactive use.
+
+Optional third arg INTERNAL-FLAG non-nil means do not inform MH of the
+change."
+ (interactive (list (mh-interactive-range "Delete")
(mh-read-seq-default "Delete from" t)
nil))
- (let ((entry (mh-find-seq sequence)))
+ (let ((entry (mh-find-seq sequence))
+ (user-sequence-flag (not (mh-internal-seq sequence)))
+ (folders-changed (list mh-current-folder))
+ (msg-list ()))
(when entry
- (mh-iterate-on-msg-or-seq msg msg-or-seq
- (when (memq msg (mh-seq-msgs entry))
- (mh-notate nil ? (1+ mh-cmd-note)))
- (mh-delete-a-msg-from-seq msg sequence internal-flag)
- (mh-clear-text-properties nil))
- (mh-notate-user-sequences msg-or-seq)
+ (mh-iterate-on-range msg range
+ (push msg msg-list)
+ ;; Calling "mark" repeatedly takes too long. So we will pretend here
+ ;; that we are just modifying an internal sequence...
+ (when (memq msg (cdr entry))
+ (mh-remove-sequence-notation msg (not user-sequence-flag)))
+ (mh-delete-a-msg-from-seq msg sequence t))
+ ;; ... and here we will "mark" all the messages at one go.
+ (unless internal-flag (mh-undefine-sequence sequence msg-list))
+ (when (and mh-index-data (not internal-flag))
+ (setq folders-changed
+ (append folders-changed
+ (mh-index-delete-from-sequence sequence msg-list))))
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
- (mh-speed-flists t mh-current-folder)))))
+ (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.
(mh-undefine-sequence sequence (list msg)))
(setcdr entry (delq msg (mh-seq-msgs entry))))))
-(defun mh-clear-text-properties (message)
- "Clear all text properties (except mh-tick) from the scan line for MESSAGE."
- (save-excursion
- (with-mh-folder-updating (t)
- (when (or (not message) (mh-goto-msg message t t))
- (beginning-of-line)
- (let ((tick-property (get-text-property (point) 'mh-tick)))
- (set-text-properties (point) (line-end-position) nil)
- (when tick-property
- (add-text-properties (point) (line-end-position)
- `(mh-tick ,tick-property))))))))
-
(defun mh-undefine-sequence (seq msgs)
"Remove from the SEQ the list of MSGS."
- (prog1 (mh-exec-cmd "mark" mh-current-folder "-delete"
- "-sequence" (symbol-name seq)
- (mh-coalesce-msg-list msgs))
- (when (and (eq seq mh-unseen-seq) (mh-speed-flists-active-p))
- (mh-speed-flists t mh-current-folder))))
+ (when (and (mh-valid-seq-p seq) msgs)
+ (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
+ "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
(defun mh-define-sequence (seq msgs)
"Define the SEQ to contain the list of MSGS.
Do not mark pseudo-sequences or empty sequences.
-Signals an error if SEQ is an illegal name."
+Signals an error if SEQ is an invalid name."
(if (and msgs
+ (mh-valid-seq-p seq)
(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."
\f
-;;; User prompting commands.
-
-(defun mh-read-msg-range (folder &optional always-prompt-flag)
- "Prompt for message range from FOLDER.
-If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
-range."
- (multiple-value-bind (total unseen) (mh-folder-size folder)
- (cond
- ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
- (list (symbol-name mh-unseen-seq)))
- ((or (null mh-large-folder) (not (numberp total)))
- (list "all"))
- ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
- (let* ((prompt
- (format "Range or number of messages to read (default: %s): "
- total))
- (in (read-string prompt nil nil (number-to-string total))))
- (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
- (list (format "last:%s" (car (read-from-string in)))))
- ((equal in "") (list "all"))
- (t (split-string in)))))
- (t (list "all")))))
-
-\f
-
;;; Build the folder-mode keymap:
(suppress-keymap mh-folder-mode-map)
"'" 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
"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
(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
"n" mh-index-new-messages
"o" mh-alt-visit-folder
"p" mh-pack-folder
+ "q" mh-index-sequenced-messages
"r" mh-rescan-folder
"s" mh-search-folder
"u" mh-undo-folder
"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
(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
"'" mh-narrow-to-tick
"?" mh-prefix-help
+ "c" mh-narrow-to-cc
+ "f" mh-narrow-to-from
+ "r" mh-narrow-to-range
"s" mh-narrow-to-subject
+ "t" mh-narrow-to-to
"w" mh-widen)
(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
(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
(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.")
+ "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.")
- (?F "[l]ist, [v]isit folder;\n"
- "[t]hread; [s]earch; [i]ndexed search;\n"
+ (?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")
- (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
+ (?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 [s]ubject; [w]iden")
+ (?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden")
(?X "un[s]har, [u]udecode message")
(?D "[b]urst digest")
(?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
;;; sentence-end-double-space: nil
;;; End:
+;;; arch-tag: cce884de-bd37-4104-9963-e4439d5ed22b
;;; mh-e.el ends here
HCoop / bpt / emacs.git / blobdiff