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, 86, 87, 88, 90, 92, 93, 94, 95, 97, 1999, |
4 |
;; 2000, 01, 02, 2003 Free Software Foundation, Inc. |
;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Bill Wohler <wohler@newt.com> |
;; Author: Bill Wohler <wohler@newt.com> |
7 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
8 |
;; Version: 7.3 |
;; Version: 7.4.4 |
9 |
;; Keywords: mail |
;; Keywords: mail |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
82 |
|
|
83 |
;;; Code: |
;;; Code: |
84 |
|
|
85 |
(require 'cl) |
(provide 'mh-e) |
86 |
|
(require 'mh-utils) |
87 |
|
(mh-require-cl) |
88 |
|
|
89 |
(defvar recursive-load-depth-limit) |
(defvar recursive-load-depth-limit) |
90 |
(eval-when (compile load eval) |
(eval-when (compile load eval) |
94 |
(setq recursive-load-depth-limit 50))) |
(setq recursive-load-depth-limit 50))) |
95 |
|
|
96 |
(require 'mh-inc) |
(require 'mh-inc) |
|
(require 'mh-utils) |
|
97 |
(require 'gnus-util) |
(require 'gnus-util) |
98 |
(require 'easymenu) |
(require 'easymenu) |
|
(if mh-xemacs-flag |
|
|
(require 'mh-xemacs-compat)) |
|
99 |
|
|
100 |
;; Shush the byte-compiler |
;; Shush the byte-compiler |
101 |
(defvar font-lock-auto-fontify) |
(defvar font-lock-auto-fontify) |
102 |
(defvar font-lock-defaults) |
(defvar font-lock-defaults) |
103 |
|
|
104 |
(defconst mh-version "7.3" "Version number of MH-E.") |
(defconst mh-version "7.4.4" "Version number of MH-E.") |
105 |
|
|
106 |
;;; Autoloads |
;;; Autoloads |
107 |
(autoload 'Info-goto-node "info") |
(autoload 'Info-goto-node "info") |
282 |
'(3 mh-folder-scan-format-face)) |
'(3 mh-folder-scan-format-face)) |
283 |
;; Current message line |
;; Current message line |
284 |
(list mh-scan-cur-msg-regexp |
(list mh-scan-cur-msg-regexp |
285 |
'(1 mh-folder-cur-msg-face prepend t)) |
'(1 mh-folder-cur-msg-face prepend t))) |
|
;; Unseen messages in bold |
|
|
'(mh-folder-font-lock-unseen (1 'bold append t))) |
|
286 |
"Regexp keywords used to fontify the MH-Folder buffer.") |
"Regexp keywords used to fontify the MH-Folder buffer.") |
287 |
|
|
288 |
(defvar mh-scan-cmd-note-width 1 |
(defvar mh-scan-cmd-note-width 1 |
396 |
(goto-char (point-min)) |
(goto-char (point-min)) |
397 |
(sort (mh-read-msg-list) '<))))))))) |
(sort (mh-read-msg-list) '<))))))))) |
398 |
|
|
399 |
(defvar mh-folder-unseen-seq-cache nil |
(defmacro mh-generate-sequence-font-lock (seq prefix face) |
400 |
"Internal cache variable used for font-lock in MH-E. |
"Generate the appropriate code to fontify messages in SEQ. |
401 |
|
PREFIX is used to generate unique names for the variables and functions |
402 |
|
defined by the macro. So a different prefix should be provided for every |
403 |
|
invocation. |
404 |
|
FACE is the font-lock face used to display the matching scan lines." |
405 |
|
(let ((cache (intern (format "mh-folder-%s-seq-cache" prefix))) |
406 |
|
(func (intern (format "mh-folder-font-lock-%s" prefix)))) |
407 |
|
`(progn |
408 |
|
(defvar ,cache nil |
409 |
|
"Internal cache variable used for font-lock in MH-E. |
410 |
Should only be non-nil through font-lock stepping, and nil once font-lock |
Should only be non-nil through font-lock stepping, and nil once font-lock |
411 |
is done highlighting.") |
is done highlighting.") |
412 |
(make-variable-buffer-local 'mh-folder-unseen-seq-cache) |
(make-variable-buffer-local ',cache) |
413 |
|
|
414 |
|
(defun ,func (limit) |
415 |
|
"Return unseen message lines to font-lock between point and LIMIT." |
416 |
|
(if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq)))) |
417 |
|
(let ((cur-msg (mh-get-msg-num nil))) |
418 |
|
(cond ((not ,cache) |
419 |
|
nil) |
420 |
|
((>= (point) limit) ;Presumably at end of buffer |
421 |
|
(setq ,cache nil) |
422 |
|
nil) |
423 |
|
((member cur-msg ,cache) |
424 |
|
(let ((bpoint (progn (beginning-of-line)(point))) |
425 |
|
(epoint (progn (forward-line 1)(point)))) |
426 |
|
(if (<= limit (point)) (setq ,cache nil)) |
427 |
|
(set-match-data (list bpoint epoint bpoint epoint)) |
428 |
|
t)) |
429 |
|
(t |
430 |
|
;; move forward one line at a time, checking each message |
431 |
|
(while (and (= 0 (forward-line 1)) |
432 |
|
(> limit (point)) |
433 |
|
(not (member (mh-get-msg-num nil) ,cache)))) |
434 |
|
;; Examine how we must have exited the loop... |
435 |
|
(let ((cur-msg (mh-get-msg-num nil))) |
436 |
|
(cond ((or (<= limit (point)) |
437 |
|
(not (member cur-msg ,cache))) |
438 |
|
(setq ,cache nil) |
439 |
|
nil) |
440 |
|
((member cur-msg ,cache) |
441 |
|
(let ((bpoint (progn (beginning-of-line) (point))) |
442 |
|
(epoint (progn (forward-line 1) (point)))) |
443 |
|
(if (<= limit (point)) (setq ,cache nil)) |
444 |
|
(set-match-data |
445 |
|
(list bpoint epoint bpoint epoint)) |
446 |
|
t)))))))) |
447 |
|
|
448 |
|
(setq mh-folder-font-lock-keywords |
449 |
|
(append mh-folder-font-lock-keywords |
450 |
|
(list (list ',func (list 1 '',face 'prepend t)))))))) |
451 |
|
|
452 |
(defun mh-folder-font-lock-unseen (limit) |
(mh-generate-sequence-font-lock mh-unseen-seq unseen bold) |
453 |
"Return unseen message lines to font-lock between point and LIMIT." |
(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick-face) |
|
(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)))))))) |
|
454 |
|
|
455 |
|
|
456 |
|
|
472 |
|
|
473 |
(defvar mh-next-direction 'forward) ;Direction to move to next message. |
(defvar mh-next-direction 'forward) ;Direction to move to next message. |
474 |
|
|
|
(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? |
|
|
|
|
475 |
(defvar mh-view-ops ()) ;Stack of ops that change the folder |
(defvar mh-view-ops ()) ;Stack of ops that change the folder |
476 |
;view (such as narrowing or threading). |
;view (such as narrowing or threading). |
477 |
|
(defvar mh-folder-view-stack ()) ;Stack of previous folder views. |
478 |
|
|
479 |
(defvar mh-index-data nil) ;Info about index search results |
(defvar mh-index-data nil) ;Info about index search results |
480 |
(defvar mh-index-previous-search nil) |
(defvar mh-index-previous-search nil) |
481 |
(defvar mh-index-msg-checksum-map nil) |
(defvar mh-index-msg-checksum-map nil) |
482 |
(defvar mh-index-checksum-origin-map nil) |
(defvar mh-index-checksum-origin-map nil) |
483 |
|
(defvar mh-index-sequence-search-flag nil) |
484 |
|
|
485 |
(defvar mh-first-msg-num nil) ;Number of first msg in buffer. |
(defvar mh-first-msg-num nil) ;Number of first msg in buffer. |
486 |
|
|
488 |
|
|
489 |
(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. |
(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer. |
490 |
|
|
491 |
|
(defvar mh-sequence-notation-history nil) |
492 |
|
;Rememeber original notation that |
493 |
|
;is overwritten by `mh-note-seq'. |
494 |
|
|
495 |
;;; Macros and generic functions: |
;;; Macros and generic functions: |
496 |
|
|
497 |
(defun mh-mapc (function list) |
(defun mh-mapc (function list) |
501 |
(setq list (cdr list)))) |
(setq list (cdr list)))) |
502 |
|
|
503 |
(defun mh-scan-format () |
(defun mh-scan-format () |
504 |
"Return \"-format\" argument for the scan program." |
"Return the output format argument for the scan program." |
505 |
(if (equal mh-scan-format-file t) |
(if (equal mh-scan-format-file t) |
506 |
(list "-format" (if mh-nmh-flag |
(list "-format" (if mh-nmh-flag |
507 |
(list (mh-update-scan-format |
(list (mh-update-scan-format |
509 |
(list (mh-update-scan-format |
(list (mh-update-scan-format |
510 |
mh-scan-format-mh mh-cmd-note)))) |
mh-scan-format-mh mh-cmd-note)))) |
511 |
(if (not (equal mh-scan-format-file nil)) |
(if (not (equal mh-scan-format-file nil)) |
512 |
(list "-format" mh-scan-format-file)))) |
(list "-form" mh-scan-format-file)))) |
513 |
|
|
514 |
|
|
515 |
|
|
543 |
|
|
544 |
;;; User executable MH-E commands: |
;;; User executable MH-E commands: |
545 |
|
|
546 |
(defun mh-delete-msg (msg-or-seq) |
(defun mh-delete-msg (range) |
547 |
"Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next. |
"Mark the specified RANGE for subsequent deletion and move to the next. |
548 |
Default is the displayed message. |
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)) |
|
549 |
|
|
550 |
(defun mh-delete-msg-no-motion (msg-or-seq) |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
551 |
"Mark the specified MSG-OR-SEQ for subsequent deletion. |
interactive use." |
552 |
Default is the displayed message. |
(interactive (list (mh-interactive-range "Delete"))) |
553 |
If optional prefix argument is provided, then prompt for the message sequence. |
(mh-delete-msg-no-motion range) |
554 |
If variable `transient-mark-mode' is non-nil and the mark is active, then the |
(if (looking-at mh-scan-deleted-msg-regexp) (mh-next-msg))) |
555 |
selected region is marked for deletion. |
|
556 |
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a |
(defun mh-delete-msg-no-motion (range) |
557 |
region in a cons cell, or a sequence." |
"Mark the specified RANGE for subsequent deletion. |
558 |
(interactive (list (mh-interactive-msg-or-seq "Delete"))) |
|
559 |
(mh-iterate-on-msg-or-seq () msg-or-seq |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
560 |
|
interactive use." |
561 |
|
(interactive (list (mh-interactive-range "Delete"))) |
562 |
|
(mh-iterate-on-range () range |
563 |
(mh-delete-a-msg nil))) |
(mh-delete-a-msg nil))) |
564 |
|
|
565 |
(defun mh-execute-commands () |
(defun mh-execute-commands () |
566 |
"Process outstanding delete and refile requests." |
"Process outstanding delete and refile requests." |
567 |
(interactive) |
(interactive) |
568 |
(if mh-narrowed-to-seq (mh-widen)) |
(if mh-folder-view-stack (mh-widen t)) |
569 |
(mh-process-commands mh-current-folder) |
(mh-process-commands mh-current-folder) |
570 |
(mh-set-scan-mode) |
(mh-set-scan-mode) |
571 |
(mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency |
(mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency |
628 |
(save-excursion |
(save-excursion |
629 |
(goto-char (point-min)) |
(goto-char (point-min)) |
630 |
(or (null mh-large-folder) |
(or (null mh-large-folder) |
631 |
(not (equal (forward-line mh-large-folder) 0)) |
(not (equal (forward-line (1+ mh-large-folder)) 0)) |
632 |
(and (message "Not threading since the number of messages exceeds `mh-large-folder'") |
(and (message "Not threading since the number of messages exceeds `mh-large-folder'") |
633 |
nil)))) |
nil)))) |
634 |
(mh-toggle-threads)) |
(mh-toggle-threads)) |
675 |
Returns nil if the address was not found in either place or if the variable |
Returns nil if the address was not found in either place or if the variable |
676 |
`mh-default-folder-must-exist-flag' is nil and the folder does not exist." |
`mh-default-folder-must-exist-flag' is nil and the folder does not exist." |
677 |
;; Loop for all entries in mh-default-folder-list |
;; Loop for all entries in mh-default-folder-list |
678 |
(save-excursion |
(save-restriction |
679 |
(let ((folder-name |
(goto-char (point-min)) |
680 |
(car |
(re-search-forward "\n\n" nil t) |
681 |
(delq nil |
(narrow-to-region (point-min) (point)) |
682 |
(mapcar |
(let ((to/cc (concat (or (message-fetch-field "to") "") ", " |
683 |
(lambda (list) |
(or (message-fetch-field "cc") ""))) |
684 |
(let ((address-regexp (nth 0 list)) |
(from (or (message-fetch-field "from") "")) |
685 |
(folder (nth 1 list)) |
folder-name) |
686 |
(to-flag (nth 2 list))) |
(setq folder-name |
687 |
(when (or |
(loop for list in mh-default-folder-list |
688 |
(mh-goto-header-field (if to-flag "To:" "From:")) |
when (string-match (nth 0 list) (if (nth 2 list) to/cc from)) |
689 |
; if the To: field is missing, try Cc: |
return (nth 1 list) |
690 |
(and to-flag (mh-goto-header-field "cc:"))) |
finally return nil)) |
|
(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))))) |
|
691 |
|
|
692 |
;; Make sure a result from `mh-default-folder-list' begins with "+" |
;; Make sure a result from `mh-default-folder-list' begins with "+" |
693 |
;; since 'mh-expand-file-name below depends on it |
;; since 'mh-expand-file-name below depends on it |
736 |
""))) |
""))) |
737 |
t)) |
t)) |
738 |
|
|
739 |
(defun mh-refile-msg (msg-or-seq folder |
(defun mh-refile-msg (range folder &optional dont-update-last-destination-flag) |
740 |
&optional dont-update-last-destination-flag) |
"Refile RANGE into FOLDER. |
741 |
"Refile MSG-OR-SEQ into FOLDER. |
|
742 |
Default is the displayed message. |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
743 |
If optional prefix argument is provided, then prompt for the message sequence. |
interactive use. |
|
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. |
|
744 |
|
|
745 |
If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the |
If optional argument DONT-UPDATE-LAST-DESTINATION-FLAG is non-nil then the |
746 |
variables `mh-last-destination' and `mh-last-destination-folder' are not |
variables `mh-last-destination' and `mh-last-destination-folder' are not |
747 |
updated." |
updated." |
748 |
(interactive (list (mh-interactive-msg-or-seq "Refile") |
(interactive (list (mh-interactive-range "Refile") |
749 |
(intern (mh-prompt-for-refile-folder)))) |
(intern (mh-prompt-for-refile-folder)))) |
750 |
(unless dont-update-last-destination-flag |
(unless dont-update-last-destination-flag |
751 |
(setq mh-last-destination (cons 'refile folder) |
(setq mh-last-destination (cons 'refile folder) |
752 |
mh-last-destination-folder mh-last-destination)) |
mh-last-destination-folder mh-last-destination)) |
753 |
(mh-iterate-on-msg-or-seq () msg-or-seq |
(mh-iterate-on-range () range |
754 |
(mh-refile-a-msg nil folder)) |
(mh-refile-a-msg nil folder)) |
755 |
(mh-next-msg)) |
(when (looking-at mh-scan-refiled-msg-regexp) (mh-next-msg))) |
756 |
|
|
757 |
(defun mh-refile-or-write-again (message) |
(defun mh-refile-or-write-again (message) |
758 |
"Re-execute the last refile or write command on the given MESSAGE. |
"Re-execute the last refile or write command on the given MESSAGE. |
1001 |
(when (consp part-index) (setq part-index (car part-index))) |
(when (consp part-index) (setq part-index (car part-index))) |
1002 |
(mh-folder-mime-action part-index #'mh-mime-save-part nil)) |
(mh-folder-mime-action part-index #'mh-mime-save-part nil)) |
1003 |
|
|
1004 |
|
(defvar mh-thread-scan-line-map-stack) |
1005 |
|
|
1006 |
(defun mh-reset-threads-and-narrowing () |
(defun mh-reset-threads-and-narrowing () |
1007 |
"Reset all variables pertaining to threads and narrowing. |
"Reset all variables pertaining to threads and narrowing. |
1008 |
Also removes all content from the folder buffer." |
Also removes all content from the folder buffer." |
1009 |
(setq mh-view-ops ()) |
(setq mh-view-ops ()) |
1010 |
(setq mh-narrowed-to-seq nil) |
(setq mh-folder-view-stack ()) |
1011 |
|
(setq mh-thread-scan-line-map-stack ()) |
1012 |
(let ((buffer-read-only nil)) (erase-buffer))) |
(let ((buffer-read-only nil)) (erase-buffer))) |
1013 |
|
|
1014 |
(defun mh-rescan-folder (&optional range dont-exec-pending) |
(defun mh-rescan-folder (&optional range dont-exec-pending) |
1018 |
If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and |
If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and |
1019 |
refiles aren't carried out." |
refiles aren't carried out." |
1020 |
(interactive (list (if current-prefix-arg |
(interactive (list (if current-prefix-arg |
1021 |
(mh-read-msg-range mh-current-folder t) |
(mh-read-range "Rescan" mh-current-folder t nil t |
1022 |
|
mh-interpret-number-as-range-flag) |
1023 |
nil))) |
nil))) |
1024 |
(setq mh-next-direction 'forward) |
(setq mh-next-direction 'forward) |
1025 |
(let ((threaded-flag (memq 'unthread mh-view-ops))) |
(let ((threaded-flag (memq 'unthread mh-view-ops))) |
1063 |
(mh-set-scan-mode) |
(mh-set-scan-mode) |
1064 |
(mh-show))) |
(mh-show))) |
1065 |
|
|
1066 |
(defun mh-undo (msg-or-seq) |
(defun mh-undo (range) |
1067 |
"Undo the pending deletion or refile of the specified MSG-OR-SEQ. |
"Undo the pending deletion or refile of the specified RANGE. |
1068 |
Default is the displayed message. |
|
1069 |
If optional prefix argument is provided, then prompt for the message sequence. |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
1070 |
If variable `transient-mark-mode' is non-nil and the mark is active, then the |
interactive use." |
1071 |
selected region is unmarked. |
(interactive (list (mh-interactive-range "Undo"))) |
1072 |
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a |
(cond ((numberp range) |
|
region in a cons cell, or a sequence." |
|
|
(interactive (list (mh-interactive-msg-or-seq "Undo"))) |
|
|
(cond ((numberp msg-or-seq) |
|
1073 |
(let ((original-position (point))) |
(let ((original-position (point))) |
1074 |
(beginning-of-line) |
(beginning-of-line) |
1075 |
(while (not (or (looking-at mh-scan-deleted-msg-regexp) |
(while (not (or (looking-at mh-scan-deleted-msg-regexp) |
1085 |
(mh-maybe-show)) |
(mh-maybe-show)) |
1086 |
(goto-char original-position) |
(goto-char original-position) |
1087 |
(error "Nothing to undo")))) |
(error "Nothing to undo")))) |
1088 |
(t (mh-iterate-on-msg-or-seq () msg-or-seq |
(t (mh-iterate-on-range () range |
1089 |
(mh-undo-msg nil)))) |
(mh-undo-msg nil)))) |
1090 |
(if (not (mh-outstanding-commands-p)) |
(if (not (mh-outstanding-commands-p)) |
1091 |
(mh-set-folder-modified-p nil))) |
(mh-set-folder-modified-p nil))) |
1187 |
(setq folder (substring folder 0 (1- (length folder))))) |
(setq folder (substring folder 0 (1- (length folder))))) |
1188 |
(values (format "+%s" folder) (car unseen) (car total)))))))) |
(values (format "+%s" folder) (car unseen) (car total)))))))) |
1189 |
|
|
1190 |
(defun mh-folder-size (folder) |
(defun mh-folder-size-folder (folder) |
1191 |
"Find size of FOLDER." |
"Find size of FOLDER using `folder'." |
1192 |
|
(with-temp-buffer |
1193 |
|
(let ((u (length (cdr (assoc mh-unseen-seq |
1194 |
|
(mh-read-folder-sequences folder nil)))))) |
1195 |
|
(call-process (expand-file-name "folder" mh-progs) nil t nil |
1196 |
|
"-norecurse" folder) |
1197 |
|
(goto-char (point-min)) |
1198 |
|
(if (re-search-forward " has \\([0-9]+\\) " nil t) |
1199 |
|
(values (car (read-from-string (match-string 1))) u folder) |
1200 |
|
(values 0 u folder))))) |
1201 |
|
|
1202 |
|
(defun mh-folder-size-flist (folder) |
1203 |
|
"Find size of FOLDER using `flist'." |
1204 |
(with-temp-buffer |
(with-temp-buffer |
1205 |
(call-process (expand-file-name "flist" mh-progs) nil t nil |
(call-process (expand-file-name "flist" mh-progs) nil t nil |
1206 |
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) |
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) |
1210 |
(buffer-substring (point) (line-end-position))) |
(buffer-substring (point) (line-end-position))) |
1211 |
(values total unseen folder)))) |
(values total unseen folder)))) |
1212 |
|
|
1213 |
|
(defun mh-folder-size (folder) |
1214 |
|
"Find size of FOLDER." |
1215 |
|
(if mh-flists-present-flag |
1216 |
|
(mh-folder-size-flist folder) |
1217 |
|
(mh-folder-size-folder folder))) |
1218 |
|
|
1219 |
(defun mh-visit-folder (folder &optional range index-data) |
(defun mh-visit-folder (folder &optional range index-data) |
1220 |
"Visit FOLDER and display RANGE of messages. |
"Visit FOLDER and display RANGE of messages. |
1221 |
Do not call this function from outside MH-E; see \\[mh-rmail] instead. |
Do not call this function from outside MH-E; see \\[mh-rmail] instead. |
1230 |
regardless of the size of the `mh-large-folder' variable." |
regardless of the size of the `mh-large-folder' variable." |
1231 |
(interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t))) |
(interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t))) |
1232 |
(list folder-name |
(list folder-name |
1233 |
(mh-read-msg-range folder-name current-prefix-arg)))) |
(mh-read-range "Scan" folder-name t nil |
1234 |
|
current-prefix-arg |
1235 |
|
mh-interpret-number-as-range-flag)))) |
1236 |
(let ((config (current-window-configuration)) |
(let ((config (current-window-configuration)) |
1237 |
(current-buffer (current-buffer)) |
(current-buffer (current-buffer)) |
1238 |
(threaded-view-flag mh-show-threads-flag)) |
(threaded-view-flag mh-show-threads-flag)) |
1245 |
(setq mh-index-data (car index-data) |
(setq mh-index-data (car index-data) |
1246 |
mh-index-msg-checksum-map (make-hash-table :test #'equal) |
mh-index-msg-checksum-map (make-hash-table :test #'equal) |
1247 |
mh-index-checksum-origin-map (make-hash-table :test #'equal)) |
mh-index-checksum-origin-map (make-hash-table :test #'equal)) |
1248 |
(mh-index-update-maps folder (cadr index-data))) |
(mh-index-update-maps folder (cadr index-data)) |
1249 |
|
(mh-index-create-sequences)) |
1250 |
(mh-scan-folder folder (or range "all")) |
(mh-scan-folder folder (or range "all")) |
1251 |
(cond ((and threaded-view-flag |
(cond ((and threaded-view-flag |
1252 |
(save-excursion |
(save-excursion |
1253 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1254 |
(or (null mh-large-folder) |
(or (null mh-large-folder) |
1255 |
(not (equal (forward-line mh-large-folder) 0)) |
(not (equal (forward-line (1+ mh-large-folder)) 0)) |
1256 |
(and (message "Not threading since the number of messages exceeds `mh-large-folder'") |
(and (message "Not threading since the number of messages exceeds `mh-large-folder'") |
1257 |
nil)))) |
nil)))) |
1258 |
(mh-toggle-threads)) |
(mh-toggle-threads)) |
1413 |
|
|
1414 |
;;; The folder data abstraction. |
;;; The folder data abstraction. |
1415 |
|
|
1416 |
|
(defvar mh-index-data-file ".mhe_index" |
1417 |
|
"MH-E specific file where index seach info is stored.") |
1418 |
|
|
1419 |
(defun mh-make-folder (name) |
(defun mh-make-folder (name) |
1420 |
"Create a new mail folder called NAME. |
"Create a new mail folder called NAME. |
1421 |
Make it the current folder." |
Make it the current folder." |
1428 |
(mh-folder-mode) |
(mh-folder-mode) |
1429 |
(mh-set-folder-modified-p nil) |
(mh-set-folder-modified-p nil) |
1430 |
(setq buffer-file-name mh-folder-filename) |
(setq buffer-file-name mh-folder-filename) |
1431 |
|
(when (and (not mh-index-data) |
1432 |
|
(file-exists-p (concat buffer-file-name mh-index-data-file))) |
1433 |
|
(mh-index-read-data)) |
1434 |
(mh-make-folder-mode-line)) |
(mh-make-folder-mode-line)) |
1435 |
|
|
1436 |
;;; Ensure new buffers won't get this mode if default-major-mode is nil. |
;;; Ensure new buffers won't get this mode if default-major-mode is nil. |
1451 |
["List Sequences in Folder..." mh-list-sequences t] |
["List Sequences in Folder..." mh-list-sequences t] |
1452 |
["Delete Sequence..." mh-delete-seq t] |
["Delete Sequence..." mh-delete-seq t] |
1453 |
["Narrow to Sequence..." mh-narrow-to-seq t] |
["Narrow to Sequence..." mh-narrow-to-seq t] |
1454 |
["Widen from Sequence" mh-widen mh-narrowed-to-seq] |
["Widen from Sequence" mh-widen mh-folder-view-stack] |
1455 |
"--" |
"--" |
1456 |
["Narrow to Subject Sequence" mh-narrow-to-subject t] |
["Narrow to Subject Sequence" mh-narrow-to-subject t] |
1457 |
["Narrow to Tick Sequence" mh-narrow-to-tick |
["Narrow to Tick Sequence" mh-narrow-to-tick |
1526 |
(set-specifier horizontal-scrollbar-visible-p nil |
(set-specifier horizontal-scrollbar-visible-p nil |
1527 |
(cons (current-buffer) nil))))) |
(cons (current-buffer) nil))))) |
1528 |
|
|
|
;; Avoid compiler warnings in XEmacs and GNU Emacs 20 |
|
|
(eval-when-compile (defvar tool-bar-mode)) |
|
|
|
|
1529 |
(defmacro mh-write-file-functions-compat () |
(defmacro mh-write-file-functions-compat () |
1530 |
"Return `write-file-functions' if it exists. |
"Return `write-file-functions' if it exists. |
1531 |
Otherwise return `local-write-file-hooks'. This macro exists purely for |
Otherwise return `local-write-file-hooks'. This macro exists purely for |
1535 |
''write-file-functions ;Emacs 21.4 |
''write-file-functions ;Emacs 21.4 |
1536 |
''local-write-file-hooks)) ;<Emacs 21.4, XEmacs |
''local-write-file-hooks)) ;<Emacs 21.4, XEmacs |
1537 |
|
|
1538 |
;; Avoid compiler warning |
;; Avoid compiler warnings in non-bleeding edge versions of Emacs. |
1539 |
(defvar tool-bar-map) |
(eval-when-compile |
1540 |
|
(defvar tool-bar-mode) |
1541 |
|
(defvar tool-bar-map) |
1542 |
|
(defvar desktop-save-buffer)) ;Emacs 21.4 |
1543 |
|
|
1544 |
(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" |
(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" |
1545 |
"Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> |
"Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> |
1578 |
'mh-seq-list nil ; Alist of (seq . msgs) nums |
'mh-seq-list nil ; Alist of (seq . msgs) nums |
1579 |
'mh-seen-list nil ; List of displayed messages |
'mh-seen-list nil ; List of displayed messages |
1580 |
'mh-next-direction 'forward ; Direction to move to next message |
'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 |
|
1581 |
'mh-view-ops () ; Stack that keeps track of the order |
'mh-view-ops () ; Stack that keeps track of the order |
1582 |
; in which narrowing/threading has been |
; in which narrowing/threading has been |
1583 |
; carried out. |
; carried out. |
1584 |
|
'mh-folder-view-stack () ; Stack of previous views of the |
1585 |
|
; folder. |
1586 |
'mh-index-data nil ; If the folder was created by a call |
'mh-index-data nil ; If the folder was created by a call |
1587 |
; to mh-index-search this contains info |
; to mh-index-search this contains info |
1588 |
; about the search results. |
; about the search results. |
1589 |
'mh-index-previous-search nil ; Previous folder and search-regexp |
'mh-index-previous-search nil ; Previous folder and search-regexp |
1590 |
'mh-index-msg-checksum-map nil ; msg -> checksum map |
'mh-index-msg-checksum-map nil ; msg -> checksum map |
1591 |
'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) |
'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg ) |
1592 |
|
'mh-index-sequence-search-flag nil ; folder resulted from sequence search |
1593 |
'mh-first-msg-num nil ; Number of first msg in buffer |
'mh-first-msg-num nil ; Number of first msg in buffer |
1594 |
'mh-last-msg-num nil ; Number of last msg in buffer |
'mh-last-msg-num nil ; Number of last msg in buffer |
1595 |
'mh-msg-count nil ; Number of msgs in buffer |
'mh-msg-count nil ; Number of msgs in buffer |
1596 |
'mh-mode-line-annotation nil ; Indicates message range |
'mh-mode-line-annotation nil ; Indicates message range |
1597 |
|
'mh-sequence-notation-history (make-hash-table) |
1598 |
|
; Remember what is overwritten by |
1599 |
|
; mh-note-seq. |
1600 |
'mh-previous-window-config nil) ; Previous window configuration |
'mh-previous-window-config nil) ; Previous window configuration |
1601 |
(mh-remove-xemacs-horizontal-scrollbar) |
(mh-remove-xemacs-horizontal-scrollbar) |
1602 |
(setq truncate-lines t) |
(setq truncate-lines t) |
1614 |
(easy-menu-add mh-folder-sequence-menu) |
(easy-menu-add mh-folder-sequence-menu) |
1615 |
(easy-menu-add mh-folder-message-menu) |
(easy-menu-add mh-folder-message-menu) |
1616 |
(easy-menu-add mh-folder-folder-menu) |
(easy-menu-add mh-folder-folder-menu) |
1617 |
(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)) |
|
1618 |
(mh-funcall-if-exists mh-toolbar-init :folder) |
(mh-funcall-if-exists mh-toolbar-init :folder) |
1619 |
(if (and mh-xemacs-flag |
(if (and mh-xemacs-flag |
1620 |
font-lock-auto-fontify) |
font-lock-auto-fontify) |
1627 |
(set (make-local-variable (car pairs)) (car (cdr pairs))) |
(set (make-local-variable (car pairs)) (car (cdr pairs))) |
1628 |
(setq pairs (cdr (cdr pairs))))) |
(setq pairs (cdr (cdr pairs))))) |
1629 |
|
|
1630 |
|
;;;###autoload |
1631 |
|
(defun mh-restore-desktop-buffer (desktop-buffer-file-name |
1632 |
|
desktop-buffer-name |
1633 |
|
desktop-buffer-misc) |
1634 |
|
"Restore an MH folder buffer specified in a desktop file." |
1635 |
|
(mh-find-path) |
1636 |
|
(mh-visit-folder desktop-buffer-name) |
1637 |
|
(current-buffer)) |
1638 |
|
|
1639 |
(defun mh-scan-folder (folder range &optional dont-exec-pending) |
(defun mh-scan-folder (folder range &optional dont-exec-pending) |
1640 |
"Scan the FOLDER over the RANGE. |
"Scan the FOLDER over the RANGE. |
1641 |
If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and |
If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and |
1676 |
(range (if (and range (atom range)) (list range) range)) |
(range (if (and range (atom range)) (list range) range)) |
1677 |
scan-start) |
scan-start) |
1678 |
(message "Scanning %s..." folder) |
(message "Scanning %s..." folder) |
1679 |
|
(mh-remove-all-notation) |
1680 |
(with-mh-folder-updating (nil) |
(with-mh-folder-updating (nil) |
1681 |
(if update |
(if update |
1682 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1768 |
(message "inc %s..." folder)) |
(message "inc %s..." folder)) |
1769 |
(setq mh-next-direction 'forward) |
(setq mh-next-direction 'forward) |
1770 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1771 |
|
(mh-remove-all-notation) |
1772 |
(let ((start-of-inc (point))) |
(let ((start-of-inc (point))) |
|
(mh-remove-cur-notation) |
|
1773 |
(if maildrop-name |
(if maildrop-name |
1774 |
;; I think MH 5 used "-ms-file" instead of "-file", |
;; I think MH 5 used "-ms-file" instead of "-file", |
1775 |
;; which would make inc'ing from maildrops fail. |
;; which would make inc'ing from maildrops fail. |
1789 |
(re-search-forward "^inc: no mail" nil t)) |
(re-search-forward "^inc: no mail" nil t)) |
1790 |
(message "No new mail%s%s" (if maildrop-name " in " "") |
(message "No new mail%s%s" (if maildrop-name " in " "") |
1791 |
(if maildrop-name maildrop-name ""))) |
(if maildrop-name maildrop-name ""))) |
1792 |
((and (when mh-narrowed-to-seq |
((and (when mh-folder-view-stack |
1793 |
(let ((saved-text (buffer-substring-no-properties |
(let ((saved-text (buffer-substring-no-properties |
1794 |
start-of-inc (point-max)))) |
start-of-inc (point-max)))) |
1795 |
(delete-region start-of-inc (point-max)) |
(delete-region start-of-inc (point-max)) |
1796 |
(unwind-protect (mh-widen) |
(unwind-protect (mh-widen t) |
1797 |
|
(mh-remove-all-notation) |
1798 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1799 |
(setq start-of-inc (point)) |
(setq start-of-inc (point)) |
1800 |
(insert saved-text) |
(insert saved-text) |
1816 |
(setq mh-seq-list (mh-read-folder-sequences folder t)) |
(setq mh-seq-list (mh-read-folder-sequences folder t)) |
1817 |
(when (equal (point-max) start-of-inc) |
(when (equal (point-max) start-of-inc) |
1818 |
(mh-notate-cur)) |
(mh-notate-cur)) |
|
(mh-notate-user-sequences) |
|
1819 |
(if new-mail-flag |
(if new-mail-flag |
1820 |
(progn |
(progn |
1821 |
(mh-make-folder-mode-line) |
(mh-make-folder-mode-line) |
1824 |
(when (memq 'unthread mh-view-ops) |
(when (memq 'unthread mh-view-ops) |
1825 |
(mh-thread-inc folder start-of-inc)) |
(mh-thread-inc folder start-of-inc)) |
1826 |
(mh-goto-cur-msg)) |
(mh-goto-cur-msg)) |
1827 |
(goto-char point-before-inc)))))) |
(goto-char point-before-inc)) |
1828 |
|
(mh-notate-user-sequences) |
1829 |
|
(mh-notate-deleted-and-refiled))))) |
1830 |
|
|
1831 |
(defun mh-make-folder-mode-line (&optional ignored) |
(defun mh-make-folder-mode-line (&optional ignored) |
1832 |
"Set the fields of the mode line for a folder buffer. |
"Set the fields of the mode line for a folder buffer. |
1869 |
("")))))) |
("")))))) |
1870 |
(mh-logo-display)))) |
(mh-logo-display)))) |
1871 |
|
|
1872 |
|
;;; XXX: Remove this function, if no one uses it any more... |
1873 |
(defun mh-unmark-all-headers (remove-all-flags) |
(defun mh-unmark-all-headers (remove-all-flags) |
1874 |
"Remove all '+' flags from the folder listing. |
"Remove all '+' flags from the folder listing. |
1875 |
With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. |
With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. |
1876 |
Optimized for speed (i.e., no regular expressions)." |
Optimized for speed (i.e., no regular expressions). |
1877 |
|
|
1878 |
|
This function is deprecated. Use `mh-remove-all-notation' instead." |
1879 |
(save-excursion |
(save-excursion |
1880 |
(let ((case-fold-search nil) |
(let ((case-fold-search nil) |
1881 |
(last-line (1- (point-max))) |
(last-line (1- (point-max))) |
1900 |
(insert " "))))) |
(insert " "))))) |
1901 |
(forward-line))))) |
(forward-line))))) |
1902 |
|
|
1903 |
|
(defun mh-add-sequence-notation (msg internal-seq-flag) |
1904 |
|
"Add sequence notation to the MSG on the current line. |
1905 |
|
If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the |
1906 |
|
current line, so that font-lock would automatically refontify it." |
1907 |
|
(with-mh-folder-updating (t) |
1908 |
|
(save-excursion |
1909 |
|
(beginning-of-line) |
1910 |
|
(if internal-seq-flag |
1911 |
|
(mh-notate nil nil mh-cmd-note) |
1912 |
|
(forward-char (1+ mh-cmd-note)) |
1913 |
|
(let ((stack (gethash msg mh-sequence-notation-history))) |
1914 |
|
(setf (gethash msg mh-sequence-notation-history) |
1915 |
|
(cons (char-after) stack))) |
1916 |
|
(mh-notate nil mh-note-seq (1+ mh-cmd-note)))))) |
1917 |
|
|
1918 |
|
(defun mh-remove-sequence-notation (msg internal-seq-flag &optional all) |
1919 |
|
"Remove sequence notation from the MSG on the current line. |
1920 |
|
If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to highlight the |
1921 |
|
sequence. In that case, no notation needs to be removed. Otherwise the effect |
1922 |
|
of inserting `mh-note-seq' needs to be reversed. |
1923 |
|
If ALL is non-nil, then all sequence marks on the scan line are removed." |
1924 |
|
(with-mh-folder-updating (t) |
1925 |
|
;; This takes care of internal sequences... |
1926 |
|
(mh-notate nil nil mh-cmd-note) |
1927 |
|
(unless internal-seq-flag |
1928 |
|
;; ... and this takes care of user sequences. |
1929 |
|
(let ((stack (gethash msg mh-sequence-notation-history))) |
1930 |
|
(while (and all (cdr stack)) |
1931 |
|
(setq stack (cdr stack))) |
1932 |
|
(when stack |
1933 |
|
(mh-notate nil (car stack) (1+ mh-cmd-note))) |
1934 |
|
(setf (gethash msg mh-sequence-notation-history) (cdr stack)))))) |
1935 |
|
|
1936 |
(defun mh-remove-cur-notation () |
(defun mh-remove-cur-notation () |
1937 |
"Remove old cur notation." |
"Remove old cur notation." |
1938 |
(let ((cur-msg (car (mh-seq-to-msgs 'cur)))) |
(let ((cur-msg (car (mh-seq-to-msgs 'cur)))) |
1948 |
(save-excursion |
(save-excursion |
1949 |
(setq overlay-arrow-position nil) |
(setq overlay-arrow-position nil) |
1950 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1951 |
(while (not (eobp)) |
(mh-iterate-on-range msg (cons (point-min) (point-max)) |
1952 |
(unless (or (equal (char-after) ?+) (eolp)) |
(mh-notate nil ? mh-cmd-note) |
1953 |
(mh-notate nil ? mh-cmd-note) |
(mh-remove-sequence-notation msg nil t)) |
1954 |
(when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0)) |
(clrhash mh-sequence-notation-history))) |
|
(mh-notate nil ? (1+ mh-cmd-note)))) |
|
|
(forward-line)))) |
|
1955 |
|
|
1956 |
;;;###mh-autoload |
;;;###mh-autoload |
1957 |
(defun mh-goto-cur-msg (&optional minimal-changes-flag) |
(defun mh-goto-cur-msg (&optional minimal-changes-flag) |
1996 |
;; Update the unseen sequence if it exists |
;; Update the unseen sequence if it exists |
1997 |
(mh-update-unseen) |
(mh-update-unseen) |
1998 |
|
|
1999 |
(let ((redraw-needed-flag mh-index-data)) |
(let ((redraw-needed-flag mh-index-data) |
2000 |
|
(folders-changed (list mh-current-folder)) |
2001 |
|
(seq-map (and mh-refile-list mh-refile-preserves-sequences-flag |
2002 |
|
(mh-create-sequence-map mh-seq-list))) |
2003 |
|
(dest-map (and mh-refile-list mh-refile-preserves-sequences-flag |
2004 |
|
(make-hash-table)))) |
2005 |
;; Remove invalid scan lines if we are in an index folder and then remove |
;; Remove invalid scan lines if we are in an index folder and then remove |
2006 |
;; the real messages |
;; the real messages |
2007 |
(when mh-index-data |
(when mh-index-data |
2008 |
(mh-index-delete-folder-headers) |
(mh-index-delete-folder-headers) |
2009 |
(mh-index-execute-commands)) |
(setq folders-changed |
2010 |
|
(append folders-changed (mh-index-execute-commands)))) |
2011 |
|
|
2012 |
;; Then refile messages |
;; Then refile messages |
2013 |
(mh-mapc #'(lambda (folder-msg-list) |
(mh-mapc #'(lambda (folder-msg-list) |
2014 |
(let ((dest-folder (symbol-name (car folder-msg-list))) |
(let* ((dest-folder (symbol-name (car folder-msg-list))) |
2015 |
(msgs (cdr folder-msg-list))) |
(last (car (mh-translate-range dest-folder "last"))) |
2016 |
|
(msgs (cdr folder-msg-list))) |
2017 |
|
(push dest-folder folders-changed) |
2018 |
(setq redraw-needed-flag t) |
(setq redraw-needed-flag t) |
2019 |
(apply #'mh-exec-cmd |
(apply #'mh-exec-cmd |
2020 |
"refile" "-src" folder dest-folder |
"refile" "-src" folder dest-folder |
2021 |
(mh-coalesce-msg-list msgs)) |
(mh-coalesce-msg-list msgs)) |
2022 |
(mh-delete-scan-msgs msgs))) |
(mh-delete-scan-msgs msgs) |
2023 |
|
;; Preserve sequences in destination folder... |
2024 |
|
(when (and mh-refile-preserves-sequences-flag |
2025 |
|
(numberp last)) |
2026 |
|
(clrhash dest-map) |
2027 |
|
(loop for i from (1+ last) |
2028 |
|
for msg in (sort (copy-sequence msgs) #'<) |
2029 |
|
do (loop for seq-name in (gethash msg seq-map) |
2030 |
|
do (push i (gethash seq-name dest-map)))) |
2031 |
|
(maphash |
2032 |
|
#'(lambda (seq msgs) |
2033 |
|
;; Run it in the background, since we don't care |
2034 |
|
;; about the results. |
2035 |
|
(apply #'mh-exec-cmd-daemon "mark" #'ignore |
2036 |
|
"-sequence" (symbol-name seq) dest-folder |
2037 |
|
"-add" (mapcar #'(lambda (x) (format "%s" x)) |
2038 |
|
(mh-coalesce-msg-list msgs)))) |
2039 |
|
dest-map)))) |
2040 |
mh-refile-list) |
mh-refile-list) |
2041 |
(setq mh-refile-list ()) |
(setq mh-refile-list ()) |
2042 |
|
|
2056 |
;; Redraw folder buffer if needed |
;; Redraw folder buffer if needed |
2057 |
(when (and redraw-needed-flag) |
(when (and redraw-needed-flag) |
2058 |
(when (mh-speed-flists-active-p) |
(when (mh-speed-flists-active-p) |
2059 |
(mh-speed-flists t mh-current-folder)) |
(apply #'mh-speed-flists t folders-changed)) |
2060 |
(cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max))) |
(cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max))) |
2061 |
(mh-index-data (mh-index-insert-folder-headers))))) |
(mh-index-data (mh-index-insert-folder-headers))))) |
2062 |
|
|
2067 |
(mh-invalidate-show-buffer)) |
(mh-invalidate-show-buffer)) |
2068 |
|
|
2069 |
(setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) |
(setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil)) |
2070 |
(mh-unmark-all-headers t) |
(mh-remove-all-notation) |
2071 |
(mh-notate-user-sequences) |
(mh-notate-user-sequences) |
2072 |
(message "Processing deletes and refiles for %s...done" folder))) |
(message "Processing deletes and refiles for %s...done" folder))) |
2073 |
|
|
2202 |
(setq msgs (cons num msgs))))) |
(setq msgs (cons num msgs))))) |
2203 |
msgs)) |
msgs)) |
2204 |
|
|
2205 |
(defun mh-notate-user-sequences (&optional msg-or-seq) |
(defun mh-notate-user-sequences (&optional range) |
2206 |
"Mark user-defined sequences in the messages specified by MSG-OR-SEQ. |
"Mark user-defined sequences in the messages specified by RANGE. |
2207 |
The optional argument MSG-OR-SEQ can be a message number, a list of message |
The optional argument RANGE can be a message number, a list of message |
2208 |
numbers, a sequence, a region in a cons cell, or nil in which case all |
numbers, a sequence, a region in a cons cell. If nil all messages are notated." |
2209 |
messages in the folder buffer are notated." |
(unless range |
2210 |
(unless msg-or-seq |
(setq range (cons (point-min) (point-max)))) |
|
(setq msg-or-seq (cons (point-min) (point-max)))) |
|
2211 |
(let ((seqs mh-seq-list) |
(let ((seqs mh-seq-list) |
2212 |
(msg-hash (make-hash-table)) |
(msg-hash (make-hash-table))) |
|
(tick-msgs (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))) |
|
2213 |
(dolist (seq seqs) |
(dolist (seq seqs) |
2214 |
(unless (mh-internal-seq (mh-seq-name seq)) |
(dolist (msg (mh-seq-msgs seq)) |
2215 |
(dolist (msg (mh-seq-msgs seq)) |
(push (car seq) (gethash msg msg-hash)))) |
2216 |
(setf (gethash msg msg-hash) t)))) |
(mh-iterate-on-range msg range |
2217 |
(mh-iterate-on-msg-or-seq msg msg-or-seq |
(loop for seq in (gethash msg msg-hash) |
2218 |
(when (gethash msg msg-hash) |
do (mh-add-sequence-notation msg (mh-internal-seq seq)))))) |
2219 |
(mh-notate nil mh-note-seq (1+ mh-cmd-note))) |
|
2220 |
(mh-notate-tick msg tick-msgs)))) |
(defvar mh-internal-seqs '(answered cur deleted forwarded printed)) |
2221 |
|
|
2222 |
(defun mh-internal-seq (name) |
(defun mh-internal-seq (name) |
2223 |
"Return non-nil if NAME is the name of an internal MH-E sequence." |
"Return non-nil if NAME is the name of an internal MH-E sequence." |
2224 |
(or (memq name '(answered cur deleted forwarded printed)) |
(or (memq name mh-internal-seqs) |
2225 |
(eq name mh-unseen-seq) |
(eq name mh-unseen-seq) |
2226 |
(and mh-tick-seq (eq name mh-tick-seq)) |
(and mh-tick-seq (eq name mh-tick-seq)) |
2227 |
(eq name mh-previous-seq) |
(eq name mh-previous-seq) |
2228 |
(mh-folder-name-p name))) |
(mh-folder-name-p name))) |
2229 |
|
|
2230 |
(defun mh-delete-msg-from-seq (msg-or-seq sequence &optional internal-flag) |
(defun mh-valid-seq-p (name) |
2231 |
"Delete MSG-OR-SEQ from SEQUENCE. |
"Return non-nil if NAME is a valid MH sequence name." |
2232 |
Default value of MSG-OR-SEQ is the displayed message. |
(and (symbolp name) |
2233 |
If optional prefix argument is provided, then prompt for the message sequence. |
(string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name)))) |
2234 |
If variable `transient-mark-mode' is non-nil and the mark is active, then the |
|
2235 |
selected region is deleted from SEQUENCE.. |
(defun mh-delete-msg-from-seq (range sequence &optional internal-flag) |
2236 |
In a program, MSG-OR-SEQ can be a message number, a list of message numbers, a |
"Delete RANGE from SEQUENCE. |
2237 |
region in a cons cell, or a sequence; optional third arg INTERNAL-FLAG non-nil |
|
2238 |
means do not inform MH of the change." |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
2239 |
(interactive (list (mh-interactive-msg-or-seq "Delete") |
interactive use. |
2240 |
|
|
2241 |
|
Optional third arg INTERNAL-FLAG non-nil means do not inform MH of the |
2242 |
|
change." |
2243 |
|
(interactive (list (mh-interactive-range "Delete") |
2244 |
(mh-read-seq-default "Delete from" t) |
(mh-read-seq-default "Delete from" t) |
2245 |
nil)) |
nil)) |
2246 |
(let ((entry (mh-find-seq sequence))) |
(let ((entry (mh-find-seq sequence)) |
2247 |
|
(user-sequence-flag (not (mh-internal-seq sequence))) |
2248 |
|
(folders-changed (list mh-current-folder)) |
2249 |
|
(msg-list ())) |
2250 |
(when entry |
(when entry |
2251 |
(mh-iterate-on-msg-or-seq msg msg-or-seq |
(mh-iterate-on-range msg range |
2252 |
(when (memq msg (mh-seq-msgs entry)) |
(push msg msg-list) |
2253 |
(mh-notate nil ? (1+ mh-cmd-note))) |
;; Calling "mark" repeatedly takes too long. So we will pretend here |
2254 |
(mh-delete-a-msg-from-seq msg sequence internal-flag) |
;; that we are just modifying an internal sequence... |
2255 |
(mh-clear-text-properties nil)) |
(when (memq msg (cdr entry)) |
2256 |
(mh-notate-user-sequences msg-or-seq) |
(mh-remove-sequence-notation msg (not user-sequence-flag))) |
2257 |
|
(mh-delete-a-msg-from-seq msg sequence t)) |
2258 |
|
;; ... and here we will "mark" all the messages at one go. |
2259 |
|
(unless internal-flag (mh-undefine-sequence sequence msg-list)) |
2260 |
|
(when (and mh-index-data (not internal-flag)) |
2261 |
|
(setq folders-changed |
2262 |
|
(append folders-changed |
2263 |
|
(mh-index-delete-from-sequence sequence msg-list)))) |
2264 |
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) |
(when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) |
2265 |
(mh-speed-flists t mh-current-folder))))) |
(apply #'mh-speed-flists t folders-changed))))) |
2266 |
|
|
2267 |
(defun mh-delete-a-msg-from-seq (msg sequence internal-flag) |
(defun mh-delete-a-msg-from-seq (msg sequence internal-flag) |
2268 |
"Delete MSG from SEQUENCE. |
"Delete MSG from SEQUENCE. |
2273 |
(mh-undefine-sequence sequence (list msg))) |
(mh-undefine-sequence sequence (list msg))) |
2274 |
(setcdr entry (delq msg (mh-seq-msgs entry)))))) |
(setcdr entry (delq msg (mh-seq-msgs entry)))))) |
2275 |
|
|
|
(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)))))))) |
|
|
|
|
2276 |
(defun mh-undefine-sequence (seq msgs) |
(defun mh-undefine-sequence (seq msgs) |
2277 |
"Remove from the SEQ the list of MSGS." |
"Remove from the SEQ the list of MSGS." |
2278 |
(prog1 (mh-exec-cmd "mark" mh-current-folder "-delete" |
(when (and (mh-valid-seq-p seq) msgs) |
2279 |
"-sequence" (symbol-name seq) |
(apply #'mh-exec-cmd "mark" mh-current-folder "-delete" |
2280 |
(mh-coalesce-msg-list msgs)) |
"-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)))) |
|
2281 |
|
|
2282 |
(defun mh-define-sequence (seq msgs) |
(defun mh-define-sequence (seq msgs) |
2283 |
"Define the SEQ to contain the list of MSGS. |
"Define the SEQ to contain the list of MSGS. |
2284 |
Do not mark pseudo-sequences or empty sequences. |
Do not mark pseudo-sequences or empty sequences. |
2285 |
Signals an error if SEQ is an illegal name." |
Signals an error if SEQ is an illegal name." |
2286 |
(if (and msgs |
(if (and msgs |
2287 |
|
(mh-valid-seq-p seq) |
2288 |
(not (mh-folder-name-p seq))) |
(not (mh-folder-name-p seq))) |
2289 |
(save-excursion |
(save-excursion |
2290 |
(mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" |
(mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero" |
2323 |
|
|
2324 |
|
|
2325 |
|
|
|
;;; 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"))))) |
|
|
|
|
|
|
|
|
|
|
2326 |
;;; Build the folder-mode keymap: |
;;; Build the folder-mode keymap: |
2327 |
|
|
2328 |
(suppress-keymap mh-folder-mode-map) |
(suppress-keymap mh-folder-mode-map) |
2380 |
|
|
2381 |
(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) |
(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map) |
2382 |
"?" mh-prefix-help |
"?" mh-prefix-help |
2383 |
|
"'" mh-index-ticked-messages |
2384 |
"S" mh-sort-folder |
"S" mh-sort-folder |
2385 |
"f" mh-alt-visit-folder |
"f" mh-alt-visit-folder |
2386 |
"i" mh-index-search |
"i" mh-index-search |
2389 |
"n" mh-index-new-messages |
"n" mh-index-new-messages |
2390 |
"o" mh-alt-visit-folder |
"o" mh-alt-visit-folder |
2391 |
"p" mh-pack-folder |
"p" mh-pack-folder |
2392 |
|
"q" mh-index-sequenced-messages |
2393 |
"r" mh-rescan-folder |
"r" mh-rescan-folder |
2394 |
"s" mh-search-folder |
"s" mh-search-folder |
2395 |
"u" mh-undo-folder |
"u" mh-undo-folder |
2403 |
"w" mh-junk-whitelist) |
"w" mh-junk-whitelist) |
2404 |
|
|
2405 |
(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) |
(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) |
2406 |
|
"'" mh-narrow-to-tick |
2407 |
"?" mh-prefix-help |
"?" mh-prefix-help |
2408 |
"d" mh-delete-msg-from-seq |
"d" mh-delete-msg-from-seq |
2409 |
"k" mh-delete-seq |
"k" mh-delete-seq |
2425 |
(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) |
(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map) |
2426 |
"'" mh-narrow-to-tick |
"'" mh-narrow-to-tick |
2427 |
"?" mh-prefix-help |
"?" mh-prefix-help |
2428 |
|
"c" mh-narrow-to-cc |
2429 |
|
"f" mh-narrow-to-from |
2430 |
|
"r" mh-narrow-to-range |
2431 |
"s" mh-narrow-to-subject |
"s" mh-narrow-to-subject |
2432 |
|
"t" mh-narrow-to-to |
2433 |
"w" mh-widen) |
"w" mh-widen) |
2434 |
|
|
2435 |
(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) |
(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map) |
2479 |
"[d]elete, [o]refile, e[x]ecute,\n" |
"[d]elete, [o]refile, e[x]ecute,\n" |
2480 |
"[s]end, [r]eply.\n" |
"[s]end, [r]eply.\n" |
2481 |
"Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," |
"Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," |
2482 |
"\n [T]hread, / Limit, e[X]tract, [D]igest, [I]nc spools.") |
"\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.") |
2483 |
|
|
2484 |
(?F "[l]ist, [v]isit folder;\n" |
(?F "[l]ist; [v]isit folder;\n" |
2485 |
"[t]hread; [s]earch; [i]ndexed search;\n" |
"[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n" |
2486 |
"[p]ack; [S]ort; [r]escan; [k]ill") |
"[p]ack; [S]ort; [r]escan; [k]ill") |
2487 |
(?S "[p]ut message in sequence, [n]arrow, [w]iden,\n" |
(?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n" |
2488 |
"[s]equences, [l]ist,\n" |
"[s]equences, [l]ist,\n" |
2489 |
"[d]elete message from sequence, [k]ill sequence") |
"[d]elete message from sequence, [k]ill sequence") |
2490 |
(?T "[t]oggle, [d]elete, [o]refile thread") |
(?T "[t]oggle, [d]elete, [o]refile thread") |
2491 |
(?/ "Limit to [s]ubject; [w]iden") |
(?/ "Limit to [c]c, [f]rom, [r]ange, [s]ubject, [t]o; [w]iden") |
2492 |
(?X "un[s]har, [u]udecode message") |
(?X "un[s]har, [u]udecode message") |
2493 |
(?D "[b]urst digest") |
(?D "[b]urst digest") |
2494 |
(?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" |
(?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n" |
2511 |
"^There is no other window$")) |
"^There is no other window$")) |
2512 |
(add-to-list 'debug-ignored-errors mess)) |
(add-to-list 'debug-ignored-errors mess)) |
2513 |
|
|
|
;;;; Desktop support |
|
|
|
|
|
;;;###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." |
|
|
(mh-find-path) |
|
|
(mh-visit-folder desktop-buffer-name) |
|
|
(current-buffer)) |
|
|
|
|
2514 |
(provide 'mh-e) |
(provide 'mh-e) |
2515 |
|
|
2516 |
;;; Local Variables: |
;;; Local Variables: |