70 |
|
|
71 |
;;; Code: |
;;; Code: |
72 |
|
|
73 |
(require 'mh-utils) |
(eval-when-compile (require 'mh-acros)) |
74 |
(mh-require-cl) |
(mh-require-cl) |
75 |
(require 'mh-e) |
(require 'mh-e) |
76 |
|
|
78 |
(defvar tool-bar-mode) |
(defvar tool-bar-mode) |
79 |
|
|
80 |
;;; Data structures (used in message threading)... |
;;; Data structures (used in message threading)... |
81 |
(defstruct (mh-thread-message (:conc-name mh-message-) |
(mh-defstruct (mh-thread-message (:conc-name mh-message-) |
82 |
(:constructor mh-thread-make-message)) |
(:constructor mh-thread-make-message)) |
83 |
(id nil) |
(id nil) |
84 |
(references ()) |
(references ()) |
85 |
(subject "") |
(subject "") |
86 |
(subject-re-p nil)) |
(subject-re-p nil)) |
87 |
|
|
88 |
(defstruct (mh-thread-container (:conc-name mh-container-) |
(mh-defstruct (mh-thread-container (:conc-name mh-container-) |
89 |
(:constructor mh-thread-make-container)) |
(:constructor mh-thread-make-container)) |
90 |
message parent children |
message parent children |
91 |
(real-child-p t)) |
(real-child-p t)) |
92 |
|
|
201 |
|
|
202 |
;;;###mh-autoload |
;;;###mh-autoload |
203 |
(defun mh-msg-is-in-seq (message) |
(defun mh-msg-is-in-seq (message) |
204 |
"Display the sequences that contain MESSAGE. |
"Display the sequences in which the current message appears. |
205 |
Default is the displayed message." |
Use a prefix argument to display the sequences in which another MESSAGE |
206 |
(interactive (list (mh-get-msg-num t))) |
appears." |
207 |
|
(interactive "P") |
208 |
|
(if (not message) |
209 |
|
(setq message (mh-get-msg-num t))) |
210 |
(let* ((dest-folder (loop for seq in mh-refile-list |
(let* ((dest-folder (loop for seq in mh-refile-list |
211 |
until (member message (cdr seq)) |
when (member message (cdr seq)) return (car seq) |
212 |
finally return (car seq))) |
finally return nil)) |
213 |
(deleted-flag (unless dest-folder (member message mh-delete-list)))) |
(deleted-flag (unless dest-folder (member message mh-delete-list)))) |
214 |
(message "Message %d%s is in sequences: %s" |
(message "Message %d%s is in sequences: %s" |
215 |
message |
message |
272 |
(let* ((internal-seq-flag (mh-internal-seq sequence)) |
(let* ((internal-seq-flag (mh-internal-seq sequence)) |
273 |
(original-msgs (mh-seq-msgs (mh-find-seq sequence))) |
(original-msgs (mh-seq-msgs (mh-find-seq sequence))) |
274 |
(folders (list mh-current-folder)) |
(folders (list mh-current-folder)) |
275 |
(msg-list ())) |
(msg-list (mh-range-to-msg-list range))) |
276 |
|
(mh-add-msgs-to-seq msg-list sequence nil t) |
277 |
(mh-iterate-on-range m range |
(mh-iterate-on-range m range |
|
(push m msg-list) |
|
278 |
(unless (memq m original-msgs) |
(unless (memq m original-msgs) |
279 |
(mh-add-sequence-notation m internal-seq-flag))) |
(mh-add-sequence-notation m internal-seq-flag))) |
|
(mh-add-msgs-to-seq msg-list sequence nil t) |
|
280 |
(if (not internal-seq-flag) |
(if (not internal-seq-flag) |
281 |
(setq mh-last-seq-used sequence)) |
(setq mh-last-seq-used sequence)) |
282 |
(when mh-index-data |
(when mh-index-data |
294 |
|
|
295 |
;;;###mh-autoload |
;;;###mh-autoload |
296 |
(defun mh-widen (&optional all-flag) |
(defun mh-widen (&optional all-flag) |
297 |
"Remove last restriction from current folder. |
"Restore the previous limit. |
298 |
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning |
If optional prefix argument ALL-FLAG is non-nil, remove all limits." |
|
of the view stack thereby showing all messages that the buffer originally |
|
|
contained." |
|
299 |
(interactive "P") |
(interactive "P") |
300 |
(let ((msg (mh-get-msg-num nil))) |
(let ((msg (mh-get-msg-num nil))) |
301 |
(when mh-folder-view-stack |
(when mh-folder-view-stack |
533 |
(rplaca old-seq new-name))) |
(rplaca old-seq new-name))) |
534 |
|
|
535 |
;;;###mh-autoload |
;;;###mh-autoload |
|
(defun mh-map-to-seq-msgs (func seq &rest args) |
|
|
"Invoke the FUNC at each message in the SEQ. |
|
|
SEQ can either be a list of messages or a MH sequence. The remaining ARGS are |
|
|
passed as arguments to FUNC." |
|
|
(save-excursion |
|
|
(let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq)))) |
|
|
(while msgs |
|
|
(if (mh-goto-msg (car msgs) t t) |
|
|
(apply func (car msgs) args)) |
|
|
(setq msgs (cdr msgs)))))) |
|
|
|
|
|
;;;###mh-autoload |
|
|
(defun mh-notate-seq (seq notation offset) |
|
|
"Mark the scan listing. |
|
|
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of |
|
|
the line." |
|
|
(let ((msg-list (mh-seq-to-msgs seq))) |
|
|
(mh-iterate-on-messages-in-region msg (point-min) (point-max) |
|
|
(when (member msg msg-list) |
|
|
(mh-notate nil notation offset))))) |
|
|
|
|
|
;;;###mh-autoload |
|
536 |
(defun mh-notate-cur () |
(defun mh-notate-cur () |
537 |
"Mark the MH sequence cur. |
"Mark the MH sequence cur. |
538 |
In addition to notating the current message with `mh-note-cur' the function |
In addition to notating the current message with `mh-note-cur' the function |
555 |
"-sequence" (symbol-name seq) |
"-sequence" (symbol-name seq) |
556 |
(mh-coalesce-msg-list msgs))))) |
(mh-coalesce-msg-list msgs))))) |
557 |
|
|
|
;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes |
|
|
;; that the folder buffer is sorted. However in this case that assumption |
|
|
;; doesn't hold. So we will do this the dumb way. |
|
|
;(defun mh-copy-seq-to-point (seq location) |
|
|
; ;; Copy the scan listing of the messages in SEQUENCE to after the point |
|
|
; ;; LOCATION in the current buffer. |
|
|
; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location)) |
|
|
|
|
558 |
(defvar mh-thread-last-ancestor) |
(defvar mh-thread-last-ancestor) |
559 |
|
|
560 |
(defun mh-copy-seq-to-eob (seq) |
(defun mh-copy-seq-to-eob (seq) |
584 |
(mh-index-data |
(mh-index-data |
585 |
(mh-index-insert-folder-headers))))))) |
(mh-index-insert-folder-headers))))))) |
586 |
|
|
|
(defun mh-copy-line-to-point (msg location) |
|
|
"Copy current message line to a specific location. |
|
|
The argument MSG is not used. The message in the current line is copied to |
|
|
LOCATION." |
|
|
;; msg is not used? |
|
|
;; Copy the current line to the LOCATION in the current buffer. |
|
|
(beginning-of-line) |
|
|
(save-excursion |
|
|
(let ((beginning-of-line (point)) |
|
|
end) |
|
|
(forward-line 1) |
|
|
(setq end (point)) |
|
|
(goto-char location) |
|
|
(insert-buffer-substring (current-buffer) beginning-of-line end)))) |
|
|
|
|
587 |
;;;###mh-autoload |
;;;###mh-autoload |
588 |
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body) |
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body) |
589 |
"Iterate over region. |
"Iterate over region. |
657 |
(nreverse msg-list))) |
(nreverse msg-list))) |
658 |
|
|
659 |
;;;###mh-autoload |
;;;###mh-autoload |
660 |
(defun mh-interactive-range (range-prompt) |
(defun mh-interactive-range (range-prompt &optional default) |
661 |
"Return interactive specification for message, sequence, range or region. |
"Return interactive specification for message, sequence, range or region. |
662 |
By convention, the name of this argument is RANGE. |
By convention, the name of this argument is RANGE. |
663 |
|
|
670 |
If a MH range is given, say something like last:20, then a list containing |
If a MH range is given, say something like last:20, then a list containing |
671 |
the messages in that range is returned. |
the messages in that range is returned. |
672 |
|
|
673 |
|
If DEFAULT non-nil then it is returned. |
674 |
|
|
675 |
Otherwise, the message number at point is returned. |
Otherwise, the message number at point is returned. |
676 |
|
|
677 |
This function is usually used with `mh-iterate-on-range' in order to provide |
This function is usually used with `mh-iterate-on-range' in order to provide |
678 |
a uniform interface to MH-E functions." |
a uniform interface to MH-E functions." |
679 |
(cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) |
(cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) |
680 |
(current-prefix-arg (mh-read-range range-prompt nil nil t t)) |
(current-prefix-arg (mh-read-range range-prompt nil nil t t)) |
681 |
|
(default default) |
682 |
(t (mh-get-msg-num t)))) |
(t (mh-get-msg-num t)))) |
683 |
|
|
|
;;;###mh-autoload |
|
|
(defun mh-region-to-msg-list (begin end) |
|
|
"Return a list of messages within the region between BEGIN and END." |
|
|
;; If end is end of buffer back up one position |
|
|
(setq end (if (equal end (point-max)) (1- end) end)) |
|
|
(let ((result)) |
|
|
(mh-iterate-on-messages-in-region index begin end |
|
|
(when (numberp index) (push index result))) |
|
|
result)) |
|
|
|
|
684 |
|
|
685 |
|
|
686 |
;;; Commands to handle new 'subject sequence. |
;;; Commands to handle new 'subject sequence. |
720 |
(if (or (not (looking-at mh-scan-subject-regexp)) |
(if (or (not (looking-at mh-scan-subject-regexp)) |
721 |
(not (match-string 3)) |
(not (match-string 3)) |
722 |
(string-equal "" (match-string 3))) |
(string-equal "" (match-string 3))) |
723 |
(progn (message "No subject line.") |
(progn (message "No subject line") |
724 |
nil) |
nil) |
725 |
(let ((subject (match-string-no-properties 3)) |
(let ((subject (match-string-no-properties 3)) |
726 |
(list)) |
(list)) |
783 |
(mh-container-message (gethash (gethash msg mh-thread-index-id-map) |
(mh-container-message (gethash (gethash msg mh-thread-index-id-map) |
784 |
mh-thread-id-table))))) |
mh-thread-id-table))))) |
785 |
|
|
786 |
;;;###mh-autoload |
(defun mh-edit-pick-expr (default) |
787 |
(defun mh-narrow-to-subject () |
"With prefix arg edit a pick expression. |
|
"Narrow to a sequence containing all following messages with same subject." |
|
|
(interactive) |
|
|
(let ((num (mh-get-msg-num nil)) |
|
|
(count (mh-subject-to-sequence t))) |
|
|
(cond |
|
|
((not count) ; No subject line, delete msg anyway |
|
|
nil) |
|
|
((= 0 count) ; No other msgs, delete msg anyway. |
|
|
(message "No other messages with same Subject following this one.") |
|
|
nil) |
|
|
(t ; We have a subject sequence. |
|
|
(message "Found %d messages for subject sequence." count) |
|
|
(mh-narrow-to-seq 'subject) |
|
|
(if (numberp num) |
|
|
(mh-goto-msg num t t)))))) |
|
|
|
|
|
(defun mh-read-pick-regexp (default) |
|
|
"With prefix arg read a pick regexp. |
|
788 |
If no prefix arg is given, then return DEFAULT." |
If no prefix arg is given, then return DEFAULT." |
789 |
(let ((default-string (loop for x in default concat (format " %s" x)))) |
(let ((default-string (loop for x in default concat (format " %s" x)))) |
790 |
(if (or current-prefix-arg (equal default-string "")) |
(if (or current-prefix-arg (equal default-string "")) |
791 |
(delete "" (split-string (read-string "Pick regexp: " default-string))) |
(delete "" (split-string (read-string "Pick expression: " |
792 |
|
default-string))) |
793 |
default))) |
default))) |
794 |
|
|
795 |
;;;###mh-autoload |
;;;###mh-autoload |
796 |
(defun mh-narrow-to-from (&optional regexp) |
(defun mh-narrow-to-subject (&optional pick-expr) |
797 |
"Limit to messages with the same From header field as the message at point. |
"Limit to messages with same subject. |
798 |
With a prefix argument, prompt for the regular expression, REGEXP given to |
With a prefix argument, edit PICK-EXPR. |
799 |
pick." |
|
800 |
|
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
801 |
(interactive |
(interactive |
802 |
(list (mh-read-pick-regexp (mh-current-message-header-field 'from)))) |
(list (mh-edit-pick-expr (mh-current-message-header-field 'subject)))) |
803 |
(mh-narrow-to-header-field 'from regexp)) |
(mh-narrow-to-header-field 'subject pick-expr)) |
804 |
|
|
805 |
;;;###mh-autoload |
;;;###mh-autoload |
806 |
(defun mh-narrow-to-cc (&optional regexp) |
(defun mh-narrow-to-from (&optional pick-expr) |
807 |
"Limit to messages with the same Cc header field as the message at point. |
"Limit to messages with the same `From:' field. |
808 |
With a prefix argument, prompt for the regular expression, REGEXP given to |
With a prefix argument, edit PICK-EXPR. |
809 |
pick." |
|
810 |
|
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
811 |
(interactive |
(interactive |
812 |
(list (mh-read-pick-regexp (mh-current-message-header-field 'cc)))) |
(list (mh-edit-pick-expr (mh-current-message-header-field 'from)))) |
813 |
(mh-narrow-to-header-field 'cc regexp)) |
(mh-narrow-to-header-field 'from pick-expr)) |
814 |
|
|
815 |
;;;###mh-autoload |
;;;###mh-autoload |
816 |
(defun mh-narrow-to-to (&optional regexp) |
(defun mh-narrow-to-cc (&optional pick-expr) |
817 |
"Limit to messages with the same To header field as the message at point. |
"Limit to messages with the same `Cc:' field. |
818 |
With a prefix argument, prompt for the regular expression, REGEXP given to |
With a prefix argument, edit PICK-EXPR. |
819 |
pick." |
|
820 |
|
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
821 |
(interactive |
(interactive |
822 |
(list (mh-read-pick-regexp (mh-current-message-header-field 'to)))) |
(list (mh-edit-pick-expr (mh-current-message-header-field 'cc)))) |
823 |
(mh-narrow-to-header-field 'to regexp)) |
(mh-narrow-to-header-field 'cc pick-expr)) |
824 |
|
|
825 |
(defun mh-narrow-to-header-field (header-field regexp) |
;;;###mh-autoload |
826 |
"Limit to messages whose HEADER-FIELD match REGEXP. |
(defun mh-narrow-to-to (&optional pick-expr) |
827 |
|
"Limit to messages with the same `To:' field. |
828 |
|
With a prefix argument, edit PICK-EXPR. |
829 |
|
|
830 |
|
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
831 |
|
(interactive |
832 |
|
(list (mh-edit-pick-expr (mh-current-message-header-field 'to)))) |
833 |
|
(mh-narrow-to-header-field 'to pick-expr)) |
834 |
|
|
835 |
|
(defun mh-narrow-to-header-field (header-field pick-expr) |
836 |
|
"Limit to messages whose HEADER-FIELD match PICK-EXPR. |
837 |
The MH command pick is used to do the match." |
The MH command pick is used to do the match." |
838 |
(let ((folder mh-current-folder) |
(let ((folder mh-current-folder) |
839 |
(original (mh-coalesce-msg-list |
(original (mh-coalesce-msg-list |
841 |
(msg-list ())) |
(msg-list ())) |
842 |
(with-temp-buffer |
(with-temp-buffer |
843 |
(apply #'mh-exec-cmd-output "pick" nil folder |
(apply #'mh-exec-cmd-output "pick" nil folder |
844 |
(append original (list "-list") regexp)) |
(append original (list "-list") pick-expr)) |
845 |
(goto-char (point-min)) |
(goto-char (point-min)) |
846 |
(while (not (eobp)) |
(while (not (eobp)) |
847 |
(let ((num (read-from-string |
(let ((num (read-from-string |
883 |
"Limit to messages in RANGE. |
"Limit to messages in RANGE. |
884 |
|
|
885 |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
Check the documentation of `mh-interactive-range' to see how RANGE is read in |
886 |
interactive use." |
interactive use. |
887 |
|
|
888 |
|
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
889 |
(interactive (list (mh-interactive-range "Narrow to"))) |
(interactive (list (mh-interactive-range "Narrow to"))) |
890 |
(when (assoc 'range mh-seq-list) (mh-delete-seq 'range)) |
(when (assoc 'range mh-seq-list) (mh-delete-seq 'range)) |
891 |
(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range) |
(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range) |
904 |
((not count) ; No subject line, delete msg anyway |
((not count) ; No subject line, delete msg anyway |
905 |
(mh-delete-msg (mh-get-msg-num t))) |
(mh-delete-msg (mh-get-msg-num t))) |
906 |
((= 0 count) ; No other msgs, delete msg anyway. |
((= 0 count) ; No other msgs, delete msg anyway. |
907 |
(message "No other messages with same Subject following this one.") |
(message "No other messages with same Subject following this one") |
908 |
(mh-delete-msg (mh-get-msg-num t))) |
(mh-delete-msg (mh-get-msg-num t))) |
909 |
(t ; We have a subject sequence. |
(t ; We have a subject sequence. |
910 |
(message "Marked %d messages for deletion" count) |
(message "Marked %d messages for deletion" count) |
1024 |
message) |
message) |
1025 |
(container |
(container |
1026 |
(setf (mh-container-message container) |
(setf (mh-container-message container) |
1027 |
(mh-thread-make-message :subject subject |
(mh-thread-make-message :id id :references refs |
1028 |
:subject-re-p subject-re-p |
:subject subject |
1029 |
:id id :references refs))) |
:subject-re-p subject-re-p))) |
1030 |
(t (let ((message (mh-thread-make-message |
(t (let ((message (mh-thread-make-message :id id :references refs |
1031 |
:subject subject |
:subject-re-p subject-re-p |
1032 |
:subject-re-p subject-re-p |
:subject subject))) |
|
:id id :references refs))) |
|
1033 |
(prog1 message |
(prog1 message |
1034 |
(mh-thread-get-message-container message))))))) |
(mh-thread-get-message-container message))))))) |
1035 |
|
|
1395 |
(cur-scan-line (and mh-thread-scan-line-map |
(cur-scan-line (and mh-thread-scan-line-map |
1396 |
(gethash msg mh-thread-scan-line-map))) |
(gethash msg mh-thread-scan-line-map))) |
1397 |
(old-scan-lines (loop for map in mh-thread-scan-line-map-stack |
(old-scan-lines (loop for map in mh-thread-scan-line-map-stack |
1398 |
collect (and map (gethash msg map)))) |
collect (and map (gethash msg map))))) |
|
(notation (if (stringp notation) (aref notation 0) notation))) |
|
1399 |
(when cur-scan-line |
(when cur-scan-line |
1400 |
(setf (aref (car cur-scan-line) offset) notation)) |
(setf (aref (car cur-scan-line) offset) notation)) |
1401 |
(dolist (line old-scan-lines) |
(dolist (line old-scan-lines) |
1430 |
(setf (gethash msg mh-thread-scan-line-map) v)))) |
(setf (gethash msg mh-thread-scan-line-map) v)))) |
1431 |
(when (> (hash-table-count mh-thread-scan-line-map) 0) |
(when (> (hash-table-count mh-thread-scan-line-map) 0) |
1432 |
(insert (if (bobp) "" "\n") (car x) "\n") |
(insert (if (bobp) "" "\n") (car x) "\n") |
1433 |
(mh-thread-generate-scan-lines thread-tree -2))))))) |
(mh-thread-generate-scan-lines thread-tree -2)))) |
1434 |
|
(mh-index-create-imenu-index)))) |
1435 |
|
|
1436 |
(defun mh-thread-folder () |
(defun mh-thread-folder () |
1437 |
"Generate thread view of folder." |
"Generate thread view of folder." |
1656 |
(push msg unticked) |
(push msg unticked) |
1657 |
(setcdr tick-seq (delq msg (cdr tick-seq))) |
(setcdr tick-seq (delq msg (cdr tick-seq))) |
1658 |
(when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) |
(when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) |
1659 |
(mh-remove-sequence-notation msg t)) |
(mh-remove-sequence-notation msg (mh-colors-in-use-p))) |
1660 |
(t |
(t |
1661 |
(push msg ticked) |
(push msg ticked) |
1662 |
(setq mh-last-seq-used mh-tick-seq) |
(setq mh-last-seq-used mh-tick-seq) |
1663 |
(mh-add-sequence-notation msg t)))) |
(let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list))) |
1664 |
|
(mh-add-sequence-notation msg (mh-colors-in-use-p)))))) |
1665 |
(mh-add-msgs-to-seq ticked mh-tick-seq nil t) |
(mh-add-msgs-to-seq ticked mh-tick-seq nil t) |
1666 |
(mh-undefine-sequence mh-tick-seq unticked) |
(mh-undefine-sequence mh-tick-seq unticked) |
1667 |
(when mh-index-data |
(when mh-index-data |
1670 |
|
|
1671 |
;;;###mh-autoload |
;;;###mh-autoload |
1672 |
(defun mh-narrow-to-tick () |
(defun mh-narrow-to-tick () |
1673 |
"Restrict display of this folder to just messages in `mh-tick-seq'. |
"Limit to messages in `mh-tick-seq'. |
1674 |
|
|
1675 |
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." |
1676 |
(interactive) |
(interactive) |
1677 |
(cond ((not mh-tick-seq) |
(cond ((not mh-tick-seq) |
1678 |
(error "Enable ticking by customizing `mh-tick-seq'")) |
(error "Enable ticking by customizing `mh-tick-seq'")) |
1679 |
((null (mh-seq-msgs (mh-find-seq mh-tick-seq))) |
((null (mh-seq-msgs (mh-find-seq mh-tick-seq))) |
1680 |
(message "No messages in tick sequence")) |
(message "No messages in %s sequence" mh-tick-seq)) |
1681 |
(t (mh-narrow-to-seq mh-tick-seq)))) |
(t (mh-narrow-to-seq mh-tick-seq)))) |
1682 |
|
|
|
|
|
1683 |
(provide 'mh-seq) |
(provide 'mh-seq) |
1684 |
|
|
1685 |
;;; Local Variables: |
;;; Local Variables: |