1 |
;;; mh-e.el --- GNU Emacs interface to the MH mail system |
;;; mh-e.el --- GNU Emacs interface to the MH mail system |
2 |
|
|
3 |
;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999, |
;; Copyright (C) 1985, 1986, 1987, 1988, |
4 |
;; 2000, 2005 Free Software Foundation, Inc. |
;; 1990, 1992, 1993, 1994, 1995, 1997, 1999, |
5 |
|
;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. |
6 |
|
|
7 |
;; Author: Bill Wohler <wohler@newt.com> |
;; Author: Bill Wohler <wohler@newt.com> |
8 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
9 |
;; Version: 7.82 |
;; Version: 7.84 |
10 |
;; Keywords: mail |
;; Keywords: mail |
11 |
|
|
12 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
98 |
(defvar font-lock-auto-fontify) |
(defvar font-lock-auto-fontify) |
99 |
(defvar font-lock-defaults) |
(defvar font-lock-defaults) |
100 |
|
|
101 |
(defconst mh-version "7.82" "Version number of MH-E.") |
(defconst mh-version "7.84" "Version number of MH-E.") |
|
|
|
|
;;; Autoloads |
|
|
(autoload 'Info-goto-node "info") |
|
102 |
|
|
103 |
(defvar mh-partial-folder-mode-line-annotation "select" |
(defvar mh-partial-folder-mode-line-annotation "select" |
104 |
"Annotation when displaying part of a folder. |
"Annotation when displaying part of a folder. |
576 |
(setq folder mh-inbox)) |
(setq folder mh-inbox)) |
577 |
(let ((threading-needed-flag nil)) |
(let ((threading-needed-flag nil)) |
578 |
(let ((config (current-window-configuration))) |
(let ((config (current-window-configuration))) |
579 |
(delete-other-windows) |
(when (and mh-show-buffer (get-buffer mh-show-buffer)) |
580 |
|
(delete-windows-on mh-show-buffer)) |
581 |
(cond ((not (get-buffer folder)) |
(cond ((not (get-buffer folder)) |
582 |
(mh-make-folder folder) |
(mh-make-folder folder) |
583 |
(setq threading-needed-flag mh-show-threads-flag) |
(setq threading-needed-flag mh-show-threads-flag) |
716 |
(mh-refile-a-msg nil folder)) |
(mh-refile-a-msg nil folder)) |
717 |
(when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg))) |
(when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg))) |
718 |
|
|
719 |
(defun mh-refile-or-write-again (message) |
(defun mh-refile-or-write-again (range &optional interactive-flag) |
720 |
"Re-execute the last refile or write command on the given MESSAGE. |
"Re-execute the last refile or write command on the given RANGE. |
721 |
Default is the displayed message. Use the same folder or file as the previous |
Default is the displayed message. Use the same folder or file as the previous |
722 |
refile or write command." |
refile or write command. |
723 |
(interactive (list (mh-get-msg-num t))) |
If INTERACTIVE-FLAG is non-nil then the function was called interactively." |
724 |
|
(interactive (list (mh-interactive-range "Redo") t)) |
725 |
(if (null mh-last-destination) |
(if (null mh-last-destination) |
726 |
(error "No previous refile or write")) |
(error "No previous refile or write")) |
727 |
(let (output) |
(let (output) |
728 |
(setq output |
(setq output |
729 |
(cond ((eq (car mh-last-destination) 'refile) |
(cond ((eq (car mh-last-destination) 'refile) |
730 |
(mh-refile-a-msg message (cdr mh-last-destination)) |
(mh-refile-msg range (cdr mh-last-destination)) |
731 |
(format "Destination folder: %s" (cdr mh-last-destination))) |
(format "Destination folder: %s" (cdr mh-last-destination))) |
732 |
(t |
(t |
733 |
(apply 'mh-write-msg-to-file message (cdr mh-last-destination)) |
(mh-iterate-on-range msg range |
734 |
|
(apply 'mh-write-msg-to-file msg (cdr mh-last-destination))) |
735 |
|
(mh-next-msg interactive-flag) |
736 |
(format "Destination: %s" (cdr mh-last-destination))))) |
(format "Destination: %s" (cdr mh-last-destination))))) |
|
(mh-next-msg (interactive-p)) |
|
737 |
(message output))) |
(message output))) |
738 |
|
|
739 |
(defun mh-quit () |
(defun mh-quit () |
1802 |
(message "inc %s..." folder)) |
(message "inc %s..." folder)) |
1803 |
(setq mh-next-direction 'forward) |
(setq mh-next-direction 'forward) |
1804 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1805 |
(mh-remove-all-notation) |
(mh-remove-cur-notation) |
1806 |
(let ((start-of-inc (point))) |
(let ((start-of-inc (point))) |
1807 |
(if maildrop-name |
(if maildrop-name |
1808 |
;; I think MH 5 used "-ms-file" instead of "-file", |
;; I think MH 5 used "-ms-file" instead of "-file", |
1828 |
start-of-inc (point-max)))) |
start-of-inc (point-max)))) |
1829 |
(delete-region start-of-inc (point-max)) |
(delete-region start-of-inc (point-max)) |
1830 |
(unwind-protect (mh-widen t) |
(unwind-protect (mh-widen t) |
1831 |
(mh-remove-all-notation) |
(mh-remove-cur-notation) |
1832 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1833 |
(setq start-of-inc (point)) |
(setq start-of-inc (point)) |
1834 |
(insert saved-text) |
(insert saved-text) |
1847 |
(t |
(t |
1848 |
(setq new-mail-flag t))) |
(setq new-mail-flag t))) |
1849 |
(keep-lines mh-scan-valid-regexp) ; Flush random scan lines |
(keep-lines mh-scan-valid-regexp) ; Flush random scan lines |
1850 |
(setq mh-seq-list (mh-read-folder-sequences folder t)) |
(let* ((sequences (mh-read-folder-sequences folder t)) |
1851 |
|
(new-cur (assoc 'cur sequences)) |
1852 |
|
(new-unseen (assoc mh-unseen-seq sequences))) |
1853 |
|
(unless (assoc 'cur mh-seq-list) |
1854 |
|
(push (list 'cur) mh-seq-list)) |
1855 |
|
(unless (assoc mh-unseen-seq mh-seq-list) |
1856 |
|
(push (list mh-unseen-seq) mh-seq-list)) |
1857 |
|
(setcdr (assoc 'cur mh-seq-list) (cdr new-cur)) |
1858 |
|
(setcdr (assoc mh-unseen-seq mh-seq-list) (cdr new-unseen))) |
1859 |
(when (equal (point-max) start-of-inc) |
(when (equal (point-max) start-of-inc) |
1860 |
(mh-notate-cur)) |
(mh-notate-cur)) |
1861 |
(if new-mail-flag |
(if new-mail-flag |
1867 |
(mh-thread-inc folder start-of-inc)) |
(mh-thread-inc folder start-of-inc)) |
1868 |
(mh-goto-cur-msg)) |
(mh-goto-cur-msg)) |
1869 |
(goto-char point-before-inc)) |
(goto-char point-before-inc)) |
1870 |
(mh-notate-user-sequences) |
(mh-notate-user-sequences (cons start-of-inc (point-max))))))) |
|
(mh-notate-deleted-and-refiled))))) |
|
1871 |
|
|
1872 |
(defun mh-make-folder-mode-line (&optional ignored) |
(defun mh-make-folder-mode-line (&optional ignored) |
1873 |
"Set the fields of the mode line for a folder buffer. |
"Set the fields of the mode line for a folder buffer. |
2041 |
(mh-coalesce-msg-list msgs)) |
(mh-coalesce-msg-list msgs)) |
2042 |
(mh-delete-scan-msgs msgs) |
(mh-delete-scan-msgs msgs) |
2043 |
;; Preserve sequences in destination folder... |
;; Preserve sequences in destination folder... |
2044 |
(when (and mh-refile-preserves-sequences-flag |
(when mh-refile-preserves-sequences-flag |
|
(numberp last)) |
|
2045 |
(clrhash dest-map) |
(clrhash dest-map) |
2046 |
(loop for i from (1+ last) |
(loop for i from (1+ (or last 0)) |
2047 |
for msg in (sort (copy-sequence msgs) #'<) |
for msg in (sort (copy-sequence msgs) #'<) |
2048 |
do (loop for seq-name in (gethash msg seq-map) |
do (loop for seq-name in (gethash msg seq-map) |
2049 |
do (push i (gethash seq-name dest-map)))) |
do (push i (gethash seq-name dest-map)))) |
2050 |
(maphash |
(maphash |
2051 |
#'(lambda (seq msgs) |
#'(lambda (seq msgs) |
2052 |
;; Run it in the background, since we don't care |
;; Can't be run in the background, since the |
2053 |
;; about the results. |
;; current folder is changed by mark this could |
2054 |
(apply #'mh-exec-cmd-daemon "mark" #'ignore |
;; lead to a race condition with the next refile. |
2055 |
|
(apply #'mh-exec-cmd "mark" |
2056 |
"-sequence" (symbol-name seq) dest-folder |
"-sequence" (symbol-name seq) dest-folder |
2057 |
"-add" (mapcar #'(lambda (x) (format "%s" x)) |
"-add" (mapcar #'(lambda (x) (format "%s" x)) |
2058 |
(mh-coalesce-msg-list msgs)))) |
(mh-coalesce-msg-list msgs)))) |
2209 |
(end-of-line (save-excursion (end-of-line) (point))) |
(end-of-line (save-excursion (end-of-line) (point))) |
2210 |
num) |
num) |
2211 |
(while (re-search-forward "[0-9]+" end-of-line t) |
(while (re-search-forward "[0-9]+" end-of-line t) |
2212 |
(setq num (string-to-int (buffer-substring (match-beginning 0) |
(setq num (string-to-number (buffer-substring (match-beginning 0) |
2213 |
(match-end 0)))) |
(match-end 0)))) |
2214 |
(cond ((looking-at "-") ; Message range |
(cond ((looking-at "-") ; Message range |
2215 |
(forward-char 1) |
(forward-char 1) |
2216 |
(re-search-forward "[0-9]+" end-of-line t) |
(re-search-forward "[0-9]+" end-of-line t) |
2217 |
(let ((num2 (string-to-int (buffer-substring (match-beginning 0) |
(let ((num2 (string-to-number |
2218 |
(match-end 0))))) |
(buffer-substring (match-beginning 0) |
2219 |
|
(match-end 0))))) |
2220 |
(if (< num2 num) |
(if (< num2 num) |
2221 |
(error "Bad message range: %d-%d" num num2)) |
(error "Bad message range: %d-%d" num num2)) |
2222 |
(while (<= num num2) |
(while (<= num num2) |