49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1 ;;; mh-seq.el --- MH-E sequences support
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
2
|
62847
|
3 ;; Copyright (C) 1993, 1995,
|
79713
|
4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
5
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
6 ;; Author: Bill Wohler <wohler@newt.com>
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
7 ;; Maintainer: Bill Wohler <wohler@newt.com>
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
8 ;; Keywords: mail
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
9 ;; See: mh-e.el
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
10
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
11 ;; This file is part of GNU Emacs.
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
12
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
14 ;; it under the terms of the GNU General Public License as published by
|
78231
|
15 ;; the Free Software Foundation; either version 3, or (at your option)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
16 ;; any later version.
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
17
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
21 ;; GNU General Public License for more details.
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
22
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
23 ;; You should have received a copy of the GNU General Public License
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
26 ;; Boston, MA 02110-1301, USA.
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
27
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
28 ;;; Commentary:
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
29
|
68465
|
30 ;; Sequences are stored in the alist `mh-seq-list' in the form:
|
|
31 ;; ((seq-name msgs ...) (seq-name msgs ...) ...)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
32
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
33 ;;; Change Log:
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
34
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
35 ;;; Code:
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
36
|
68465
|
37 (require 'mh-e)
|
56406
|
38 (mh-require-cl)
|
68465
|
39 (require 'mh-scan)
|
67681
|
40
|
68465
|
41 (require 'font-lock)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
42
|
68465
|
43 ;;; Variables
|
67681
|
44
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
45 (defvar mh-last-seq-used nil
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
46 "Name of seq to which a msg was last added.")
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
47
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
48 (defvar mh-non-seq-mode-line-annotation nil
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
49 "Saved value of `mh-mode-line-annotation' when narrowed to a seq.")
|
68465
|
50 (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
|
|
51
|
|
52 (defvar mh-internal-seqs '(answered cur deleted forwarded printed))
|
|
53
|
|
54 ;;; Macros
|
|
55
|
80068
|
56 (defsubst mh-make-seq (name msgs)
|
68465
|
57 "Create sequence NAME with the given MSGS."
|
80068
|
58 (cons name msgs))
|
68465
|
59
|
80068
|
60 (defsubst mh-seq-name (sequence)
|
68465
|
61 "Extract sequence name from the given SEQUENCE."
|
80068
|
62 (car sequence))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
63
|
67681
|
64
|
|
65
|
68465
|
66 ;;; MH-Folder Commands
|
|
67
|
|
68 ;; Alphabetical.
|
|
69
|
|
70 ;;;###mh-autoload
|
|
71 (defun mh-catchup (range)
|
|
72 "Delete RANGE from the \"unseen\" sequence.
|
|
73
|
|
74 Check the documentation of `mh-interactive-range' to see how
|
|
75 RANGE is read in interactive use."
|
|
76 (interactive (list (mh-interactive-range "Catchup"
|
|
77 (cons (point-min) (point-max)))))
|
|
78 (mh-delete-msg-from-seq range mh-unseen-seq))
|
|
79
|
|
80 ;;;###mh-autoload
|
|
81 (defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
|
|
82 "Delete RANGE from SEQUENCE.
|
|
83
|
|
84 Check the documentation of `mh-interactive-range' to see how
|
|
85 RANGE is read in interactive use.
|
67681
|
86
|
68465
|
87 In a program, non-nil INTERNAL-FLAG means do not inform MH of the
|
|
88 change."
|
|
89 (interactive (list (mh-interactive-range "Delete")
|
|
90 (mh-read-seq-default "Delete from" t)
|
|
91 nil))
|
|
92 (let ((entry (mh-find-seq sequence))
|
|
93 (user-sequence-flag (not (mh-internal-seq sequence)))
|
|
94 (folders-changed (list mh-current-folder))
|
|
95 (msg-list ()))
|
|
96 (when entry
|
|
97 (mh-iterate-on-range msg range
|
|
98 (push msg msg-list)
|
|
99 ;; Calling "mark" repeatedly takes too long. So we will pretend here
|
|
100 ;; that we are just modifying an internal sequence...
|
|
101 (when (memq msg (cdr entry))
|
|
102 (mh-remove-sequence-notation msg (not user-sequence-flag)))
|
|
103 (mh-delete-a-msg-from-seq msg sequence t))
|
|
104 ;; ... and here we will "mark" all the messages at one go.
|
|
105 (unless internal-flag (mh-undefine-sequence sequence msg-list))
|
|
106 (when (and mh-index-data (not internal-flag))
|
|
107 (setq folders-changed
|
|
108 (append folders-changed
|
|
109 (mh-index-delete-from-sequence sequence msg-list))))
|
|
110 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
|
|
111 (apply #'mh-speed-flists t folders-changed)))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
112
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
113 ;;;###mh-autoload
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
114 (defun mh-delete-seq (sequence)
|
66661
|
115 "Delete SEQUENCE.
|
|
116
|
67758
|
117 You are prompted for the sequence to delete. Note that this
|
|
118 deletes only the sequence, not the messages in the sequence. If
|
|
119 you want to delete the messages, use \"\\[universal-argument]
|
|
120 \\[mh-delete-msg]\"."
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
121 (interactive (list (mh-read-seq-default "Delete" t)))
|
56406
|
122 (let ((msg-list (mh-seq-to-msgs sequence))
|
|
123 (internal-flag (mh-internal-seq sequence))
|
|
124 (folders-changed (list mh-current-folder)))
|
|
125 (mh-iterate-on-range msg sequence
|
|
126 (mh-remove-sequence-notation msg internal-flag))
|
49578
|
127 (mh-undefine-sequence sequence '("all"))
|
|
128 (mh-delete-seq-locally sequence)
|
56406
|
129 (when mh-index-data
|
|
130 (setq folders-changed
|
|
131 (append folders-changed
|
|
132 (mh-index-delete-from-sequence sequence msg-list))))
|
|
133 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
|
|
134 (apply #'mh-speed-flists t folders-changed))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
135
|
68105
|
136 ;; Shush compiler.
|
70027
|
137 (defvar view-exit-action)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
138
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
139 ;;;###mh-autoload
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
140 (defun mh-list-sequences ()
|
66661
|
141 "List all sequences in folder.
|
67988
|
142
|
66661
|
143 The list appears in a buffer named \"*MH-E Sequences*\"."
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
144 (interactive)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
145 (let ((folder mh-current-folder)
|
49578
|
146 (temp-buffer mh-sequences-buffer)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
147 (seq-list mh-seq-list)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
148 (max-len 0))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
149 (with-output-to-temp-buffer temp-buffer
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
150 (save-excursion
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
151 (set-buffer temp-buffer)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
152 (erase-buffer)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
153 (message "Listing sequences ...")
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
154 (insert "Sequences in folder " folder ":\n")
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
155 (let ((seq-list seq-list))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
156 (while seq-list
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
157 (setq max-len
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
158 (max (length (symbol-name (mh-seq-name (pop seq-list))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
159 max-len)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
160 (setq max-len (+ 2 max-len)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
161 (while seq-list
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
162 (let ((name (mh-seq-name (car seq-list)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
163 (sorted-seq-msgs
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
164 (mh-coalesce-msg-list
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
165 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
166 name-spec)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
167 (insert (setq name-spec (format (format "%%%ss:" max-len) name)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
168 (while sorted-seq-msgs
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
169 (let ((next-element (format " %s" (pop sorted-seq-msgs))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
170 (when (>= (+ (current-column) (length next-element))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
171 (window-width))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
172 (insert "\n")
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
173 (insert (format (format "%%%ss" (length name-spec)) "")))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
174 (insert next-element)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
175 (insert "\n"))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
176 (setq seq-list (cdr seq-list)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
177 (goto-char (point-min))
|
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
diff
changeset
|
178 (mh-view-mode-enter)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
179 (setq view-exit-action 'kill-buffer)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
180 (message "Listing sequences...done")))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
181
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
182 ;;;###mh-autoload
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
183 (defun mh-msg-is-in-seq (message)
|
56673
|
184 "Display the sequences in which the current message appears.
|
67988
|
185
|
67758
|
186 Use a prefix argument to display the sequences in which another
|
|
187 MESSAGE appears."
|
56673
|
188 (interactive "P")
|
|
189 (if (not message)
|
|
190 (setq message (mh-get-msg-num t)))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
191 (let* ((dest-folder (loop for seq in mh-refile-list
|
56673
|
192 when (member message (cdr seq)) return (car seq)
|
|
193 finally return nil))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
194 (deleted-flag (unless dest-folder (member message mh-delete-list))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
195 (message "Message %d%s is in sequences: %s"
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
196 message
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
197 (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
198 (deleted-flag (format " (to be deleted)"))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
199 (t ""))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
200 (mapconcat 'concat
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
201 (mh-list-to-string (mh-seq-containing-msg message t))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
202 " "))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
203
|
68465
|
204 ;; Shush compiler.
|
70028
|
205 (defvar tool-bar-mode) ; XEmacs
|
66086
|
206
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
207 ;;;###mh-autoload
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
208 (defun mh-narrow-to-seq (sequence)
|
66661
|
209 "Restrict display to messages in SEQUENCE.
|
|
210
|
67758
|
211 You are prompted for the name of the sequence. What this command
|
|
212 does is show only those messages that are in the selected
|
|
213 sequence in the MH-Folder buffer. In addition, it limits further
|
|
214 MH-E searches to just those messages.
|
66661
|
215
|
67758
|
216 When you want to widen the view to all your messages again, use
|
|
217 \\[mh-widen]."
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
218 (interactive (list (mh-read-seq "Narrow to" t)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
219 (with-mh-folder-updating (t)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
220 (cond ((mh-seq-to-msgs sequence)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
221 (mh-remove-all-notation)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
222 (let ((eob (point-max))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
223 (msg-at-cursor (mh-get-msg-num nil)))
|
56406
|
224 (push mh-thread-scan-line-map mh-thread-scan-line-map-stack)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
225 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
226 (mh-copy-seq-to-eob sequence)
|
56406
|
227 (push (buffer-substring-no-properties (point-min) eob)
|
|
228 mh-folder-view-stack)
|
|
229 (delete-region (point-min) eob)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
230 (mh-notate-deleted-and-refiled)
|
49578
|
231 (mh-notate-cur)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
232 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
233 (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
234 (setq mh-mode-line-annotation (symbol-name sequence))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
235 (mh-make-folder-mode-line)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
236 (mh-recenter nil)
|
50702
|
237 (when (and (boundp 'tool-bar-mode) tool-bar-mode)
|
|
238 (set (make-local-variable 'tool-bar-map)
|
|
239 mh-folder-seq-tool-bar-map)
|
|
240 (when (buffer-live-p (get-buffer mh-show-buffer))
|
70145
|
241 (with-current-buffer mh-show-buffer
|
50702
|
242 (set (make-local-variable 'tool-bar-map)
|
|
243 mh-show-seq-tool-bar-map))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
244 (push 'widen mh-view-ops)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
245 (t
|
68013
|
246 (error "No messages in sequence %s" (symbol-name sequence))))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
247
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
248 ;;;###mh-autoload
|
68465
|
249 (defun mh-narrow-to-tick ()
|
|
250 "Limit to ticked messages.
|
|
251
|
|
252 What this command does is show only those messages that are in
|
|
253 the \"tick\" sequence (which you can customize via the
|
|
254 `mh-tick-seq' option) in the MH-Folder buffer. In addition, it
|
|
255 limits further MH-E searches to just those messages. When you
|
|
256 want to widen the view to all your messages again, use
|
|
257 \\[mh-widen]."
|
|
258 (interactive)
|
|
259 (cond ((not mh-tick-seq)
|
|
260 (error "Enable ticking by customizing `mh-tick-seq'"))
|
|
261 ((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
|
|
262 (message "No messages in %s sequence" mh-tick-seq))
|
|
263 (t (mh-narrow-to-seq mh-tick-seq))))
|
|
264
|
|
265 ;;;###mh-autoload
|
56406
|
266 (defun mh-put-msg-in-seq (range sequence)
|
67313
2ae99b10dd40
* mh-comp.el (mh-forward): Went over all uses of the word "RANGE" in
Bill Wohler <wohler@newt.com>
diff
changeset
|
267 "Add RANGE to SEQUENCE\\<mh-folder-mode-map>.
|
56406
|
268
|
67758
|
269 Give this command a RANGE and you can add all the messages in a
|
|
270 sequence to another sequence (for example,
|
|
271 \"\\[universal-argument] \\[mh-put-msg-in-seq] SourceSequence RET
|
|
272 DestSequence RET\"). Check the documentation of
|
|
273 `mh-interactive-range' to see how RANGE is read in interactive
|
|
274 use."
|
56406
|
275 (interactive (list (mh-interactive-range "Add messages from")
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
276 (mh-read-seq-default "Add to" nil)))
|
56406
|
277 (unless (mh-valid-seq-p sequence)
|
68013
|
278 (error "Can't put message in invalid sequence %s" sequence))
|
50702
|
279 (let* ((internal-seq-flag (mh-internal-seq sequence))
|
56406
|
280 (original-msgs (mh-seq-msgs (mh-find-seq sequence)))
|
|
281 (folders (list mh-current-folder))
|
56673
|
282 (msg-list (mh-range-to-msg-list range)))
|
|
283 (mh-add-msgs-to-seq msg-list sequence nil t)
|
56406
|
284 (mh-iterate-on-range m range
|
|
285 (unless (memq m original-msgs)
|
|
286 (mh-add-sequence-notation m internal-seq-flag)))
|
49578
|
287 (if (not internal-seq-flag)
|
50702
|
288 (setq mh-last-seq-used sequence))
|
56406
|
289 (when mh-index-data
|
|
290 (setq folders
|
|
291 (append folders (mh-index-add-to-sequence sequence msg-list))))
|
50702
|
292 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
|
56406
|
293 (apply #'mh-speed-flists t folders))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
294
|
68465
|
295 ;;;###mh-autoload
|
|
296 (defun mh-toggle-tick (range)
|
|
297 "Toggle tick mark of RANGE.
|
|
298
|
|
299 This command adds messages to the \"tick\" sequence (which you can customize
|
|
300 via the option `mh-tick-seq'). This sequence can be viewed later with the
|
|
301 \\[mh-index-ticked-messages] command.
|
|
302
|
|
303 Check the documentation of `mh-interactive-range' to see how RANGE is read in
|
|
304 interactive use."
|
|
305 (interactive (list (mh-interactive-range "Tick")))
|
|
306 (unless mh-tick-seq
|
|
307 (error "Enable ticking by customizing `mh-tick-seq'"))
|
|
308 (let* ((tick-seq (mh-find-seq mh-tick-seq))
|
|
309 (tick-seq-msgs (mh-seq-msgs tick-seq))
|
|
310 (ticked ())
|
|
311 (unticked ()))
|
|
312 (mh-iterate-on-range msg range
|
|
313 (cond ((member msg tick-seq-msgs)
|
|
314 (push msg unticked)
|
|
315 (setcdr tick-seq (delq msg (cdr tick-seq)))
|
|
316 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
|
|
317 (mh-remove-sequence-notation msg (mh-colors-in-use-p)))
|
|
318 (t
|
|
319 (push msg ticked)
|
|
320 (setq mh-last-seq-used mh-tick-seq)
|
|
321 (let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list)))
|
|
322 (mh-add-sequence-notation msg (mh-colors-in-use-p))))))
|
|
323 (mh-add-msgs-to-seq ticked mh-tick-seq nil t)
|
|
324 (mh-undefine-sequence mh-tick-seq unticked)
|
|
325 (when mh-index-data
|
|
326 (mh-index-add-to-sequence mh-tick-seq ticked)
|
|
327 (mh-index-delete-from-sequence mh-tick-seq unticked))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
328
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
329 ;;;###mh-autoload
|
56406
|
330 (defun mh-widen (&optional all-flag)
|
66661
|
331 "Remove last restriction.
|
67988
|
332
|
|
333 Each limit or sequence restriction can be undone in turn with
|
|
334 this command. Give this command a prefix argument ALL-FLAG to
|
|
335 remove all limits and sequence restrictions."
|
56406
|
336 (interactive "P")
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
337 (let ((msg (mh-get-msg-num nil)))
|
56406
|
338 (when mh-folder-view-stack
|
|
339 (cond (all-flag
|
|
340 (while (cdr mh-view-ops)
|
|
341 (setq mh-view-ops (cdr mh-view-ops)))
|
|
342 (when (eq (car mh-view-ops) 'widen)
|
|
343 (setq mh-view-ops (cdr mh-view-ops))))
|
|
344 ((mh-valid-view-change-operation-p 'widen) nil)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
345 ((memq 'widen mh-view-ops)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
346 (while (not (eq (car mh-view-ops) 'widen))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
347 (setq mh-view-ops (cdr mh-view-ops)))
|
56406
|
348 (setq mh-view-ops (cdr mh-view-ops)))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
349 (t (error "Widening is not applicable")))
|
56406
|
350 ;; If ALL-FLAG is non-nil then rewind stacks
|
|
351 (when all-flag
|
|
352 (while (cdr mh-thread-scan-line-map-stack)
|
|
353 (setq mh-thread-scan-line-map-stack
|
|
354 (cdr mh-thread-scan-line-map-stack)))
|
|
355 (while (cdr mh-folder-view-stack)
|
|
356 (setq mh-folder-view-stack (cdr mh-folder-view-stack))))
|
|
357 (setq mh-thread-scan-line-map (pop mh-thread-scan-line-map-stack))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
358 (with-mh-folder-updating (t)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
359 (delete-region (point-min) (point-max))
|
56406
|
360 (insert (pop mh-folder-view-stack))
|
|
361 (mh-remove-all-notation)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
362 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
363 (mh-make-folder-mode-line))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
364 (if msg
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
365 (mh-goto-msg msg t t))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
366 (mh-notate-deleted-and-refiled)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
367 (mh-notate-user-sequences)
|
49578
|
368 (mh-notate-cur)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
369 (mh-recenter nil)))
|
56406
|
370 (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode)
|
50702
|
371 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
|
|
372 (when (buffer-live-p (get-buffer mh-show-buffer))
|
70145
|
373 (with-current-buffer mh-show-buffer
|
50702
|
374 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
375
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
376
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
377
|
68465
|
378 ;;; Support Routines
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
379
|
56406
|
380 (defvar mh-sequence-history ())
|
|
381
|
|
382 ;;;###mh-autoload
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
383 (defun mh-read-seq-default (prompt not-empty)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
384 "Read and return sequence name with default narrowed or previous sequence.
|
67758
|
385 PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil
|
|
386 then a non-empty sequence is read."
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
387 (mh-read-seq prompt not-empty
|
56406
|
388 (or mh-last-seq-used
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
389 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
390
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
391 (defun mh-read-seq (prompt not-empty &optional default)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
392 "Read and return a sequence name.
|
67758
|
393 Prompt with PROMPT, raise an error if the sequence is empty and
|
|
394 the NOT-EMPTY flag is non-nil, and supply an optional DEFAULT
|
|
395 sequence. A reply of '%' defaults to the first sequence
|
|
396 containing the current message."
|
68012
|
397 (let* ((input (completing-read (format "%s sequence%s: " prompt
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
398 (if default
|
68012
|
399 (format " (default %s)" default)
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
400 ""))
|
56406
|
401 (mh-seq-names mh-seq-list)
|
|
402 nil nil nil 'mh-sequence-history))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
403 (seq (cond ((equal input "%")
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
404 (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
405 ((equal input "") default)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
406 (t (intern input))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
407 (msgs (mh-seq-to-msgs seq)))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
408 (if (and (null msgs) not-empty)
|
68013
|
409 (error "No messages in sequence %s" seq))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
410 seq))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
411
|
68465
|
412 (defun mh-internal-seq (name)
|
|
413 "Return non-nil if NAME is the name of an internal MH-E sequence."
|
|
414 (or (memq name mh-internal-seqs)
|
|
415 (eq name mh-unseen-seq)
|
|
416 (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
|
|
417 (eq name mh-previous-seq)
|
|
418 (mh-folder-name-p name)))
|
|
419
|
|
420 ;;;###mh-autoload
|
|
421 (defun mh-valid-seq-p (name)
|
|
422 "Return non-nil if NAME is a valid MH sequence name."
|
|
423 (and (symbolp name)
|
|
424 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
|
|
425
|
|
426 ;;;###mh-autoload
|
|
427 (defun mh-find-seq (name)
|
|
428 "Return sequence NAME."
|
|
429 (assoc name mh-seq-list))
|
|
430
|
|
431 ;;;###mh-autoload
|
|
432 (defun mh-seq-to-msgs (seq)
|
|
433 "Return a list of the messages in SEQ."
|
|
434 (mh-seq-msgs (mh-find-seq seq)))
|
|
435
|
|
436 (defun mh-seq-containing-msg (msg &optional include-internal-flag)
|
|
437 "Return a list of the sequences containing MSG.
|
|
438 If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences
|
|
439 in list."
|
|
440 (let ((l mh-seq-list)
|
|
441 (seqs ()))
|
|
442 (while l
|
|
443 (and (memq msg (mh-seq-msgs (car l)))
|
|
444 (or include-internal-flag
|
|
445 (not (mh-internal-seq (mh-seq-name (car l)))))
|
|
446 (setq seqs (cons (mh-seq-name (car l)) seqs)))
|
|
447 (setq l (cdr l)))
|
|
448 seqs))
|
|
449
|
|
450 ;;;###mh-autoload
|
|
451 (defun mh-define-sequence (seq msgs)
|
|
452 "Define the SEQ to contain the list of MSGS.
|
|
453 Do not mark pseudo-sequences or empty sequences.
|
|
454 Signals an error if SEQ is an invalid name."
|
|
455 (if (and msgs
|
|
456 (mh-valid-seq-p seq)
|
|
457 (not (mh-folder-name-p seq)))
|
|
458 (save-excursion
|
|
459 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
|
|
460 "-sequence" (symbol-name seq)
|
|
461 (mh-coalesce-msg-list msgs)))))
|
|
462
|
|
463 ;;;###mh-autoload
|
|
464 (defun mh-undefine-sequence (seq msgs)
|
|
465 "Remove from the SEQ the list of MSGS."
|
|
466 (when (and (mh-valid-seq-p seq) msgs)
|
|
467 (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
|
|
468 "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
|
|
469
|
|
470 ;;;###mh-autoload
|
|
471 (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag dont-annotate-flag)
|
|
472 "Add MSGS to SEQ.
|
|
473
|
|
474 Remove duplicates and keep sequence sorted. If optional
|
|
475 INTERNAL-FLAG is non-nil, do not mark the message in the scan
|
|
476 listing or inform MH of the addition.
|
|
477
|
|
478 If DONT-ANNOTATE-FLAG is non-nil then the annotations in the
|
|
479 folder buffer are not updated."
|
|
480 (let ((entry (mh-find-seq seq))
|
|
481 (internal-seq-flag (mh-internal-seq seq)))
|
|
482 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
|
|
483 (if (null entry)
|
|
484 (setq mh-seq-list
|
|
485 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
|
|
486 mh-seq-list))
|
|
487 (if msgs (setcdr entry (mh-canonicalize-sequence
|
|
488 (append msgs (mh-seq-msgs entry))))))
|
|
489 (unless internal-flag
|
|
490 (mh-add-to-sequence seq msgs)
|
|
491 (when (not dont-annotate-flag)
|
|
492 (mh-iterate-on-range msg msgs
|
|
493 (unless (memq msg (cdr entry))
|
|
494 (mh-add-sequence-notation msg internal-seq-flag)))))))
|
|
495
|
|
496 (defun mh-add-to-sequence (seq msgs)
|
|
497 "The sequence SEQ is augmented with the messages in MSGS."
|
|
498 ;; Add to a SEQUENCE each message the list of MSGS.
|
|
499 (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
|
|
500 (if msgs
|
|
501 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
|
|
502 "-sequence" (symbol-name seq)
|
|
503 (mh-coalesce-msg-list msgs)))))
|
|
504
|
|
505 (defun mh-canonicalize-sequence (msgs)
|
|
506 "Sort MSGS in decreasing order and remove duplicates."
|
|
507 (let* ((sorted-msgs (sort (copy-sequence msgs) '>))
|
|
508 (head sorted-msgs))
|
|
509 (while (cdr head)
|
|
510 (if (= (car head) (cadr head))
|
|
511 (setcdr head (cddr head))
|
|
512 (setq head (cdr head))))
|
|
513 sorted-msgs))
|
|
514
|
|
515 (defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
|
|
516 "Delete MSG from SEQUENCE.
|
|
517 If INTERNAL-FLAG is non-nil, then do not inform MH of the
|
|
518 change."
|
|
519 (let ((entry (mh-find-seq sequence)))
|
|
520 (when (and entry (memq msg (mh-seq-msgs entry)))
|
|
521 (if (not internal-flag)
|
|
522 (mh-undefine-sequence sequence (list msg)))
|
|
523 (setcdr entry (delq msg (mh-seq-msgs entry))))))
|
|
524
|
|
525 (defun mh-delete-seq-locally (seq)
|
|
526 "Remove MH-E's record of SEQ."
|
|
527 (let ((entry (mh-find-seq seq)))
|
|
528 (setq mh-seq-list (delq entry mh-seq-list))))
|
|
529
|
|
530 (defun mh-copy-seq-to-eob (seq)
|
|
531 "Copy SEQ to the end of the buffer."
|
|
532 ;; It is quite involved to write something which will work at any place in
|
|
533 ;; the buffer, so we will write something which works only at the end of
|
|
534 ;; the buffer. If we ever need to insert sequences in the middle of the
|
|
535 ;; buffer, this will need to be fixed.
|
|
536 (save-excursion
|
|
537 (let* ((msgs (mh-seq-to-msgs seq))
|
|
538 (coalesced-msgs (mh-coalesce-msg-list msgs)))
|
|
539 (goto-char (point-max))
|
|
540 (save-restriction
|
|
541 (narrow-to-region (point) (point))
|
|
542 (mh-regenerate-headers coalesced-msgs t)
|
|
543 (cond ((memq 'unthread mh-view-ops)
|
|
544 ;; Populate restricted scan-line map
|
|
545 (mh-remove-all-notation)
|
|
546 (mh-iterate-on-range msg (cons (point-min) (point-max))
|
|
547 (setf (gethash msg mh-thread-scan-line-map)
|
|
548 (mh-thread-parse-scan-line)))
|
|
549 ;; Remove scan lines and read results from pre-computed tree
|
|
550 (delete-region (point-min) (point-max))
|
|
551 (mh-thread-print-scan-lines
|
|
552 (mh-thread-generate mh-current-folder ()))
|
|
553 (mh-notate-user-sequences))
|
|
554 (mh-index-data
|
|
555 (mh-index-insert-folder-headers)))))))
|
|
556
|
|
557 ;;;###mh-autoload
|
|
558 (defun mh-valid-view-change-operation-p (op)
|
|
559 "Check if the view change operation can be performed.
|
|
560 OP is one of 'widen and 'unthread."
|
|
561 (cond ((eq (car mh-view-ops) op)
|
|
562 (pop mh-view-ops))
|
|
563 (t nil)))
|
|
564
|
67681
|
565
|
|
566
|
68465
|
567 ;;; Ranges
|
67681
|
568
|
56406
|
569 (defvar mh-range-seq-names)
|
|
570 (defvar mh-range-history ())
|
|
571 (defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map))
|
|
572 (define-key mh-range-completion-map " " 'self-insert-command)
|
|
573
|
68465
|
574 ;;;###mh-autoload
|
|
575 (defun mh-interactive-range (range-prompt &optional default)
|
|
576 "Return interactive specification for message, sequence, range or region.
|
|
577 By convention, the name of this argument is RANGE.
|
|
578
|
|
579 If variable `transient-mark-mode' is non-nil and the mark is active,
|
|
580 then this function returns a cons-cell of the region.
|
|
581
|
|
582 If optional prefix argument is provided, then prompt for message range
|
|
583 with RANGE-PROMPT. A list of messages in that range is returned.
|
|
584
|
|
585 If a MH range is given, say something like last:20, then a list
|
|
586 containing the messages in that range is returned.
|
|
587
|
|
588 If DEFAULT non-nil then it is returned.
|
|
589
|
|
590 Otherwise, the message number at point is returned.
|
|
591
|
|
592 This function is usually used with `mh-iterate-on-range' in order to
|
|
593 provide a uniform interface to MH-E functions."
|
|
594 (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
|
|
595 (current-prefix-arg (mh-read-range range-prompt nil nil t t))
|
|
596 (default default)
|
|
597 (t (mh-get-msg-num t))))
|
56406
|
598
|
|
599 ;;;###mh-autoload
|
|
600 (defun mh-read-range (prompt &optional folder default
|
|
601 expand-flag ask-flag number-as-range-flag)
|
|
602 "Read a message range with PROMPT.
|
|
603
|
67758
|
604 If FOLDER is non-nil then a range is read from that folder, otherwise
|
|
605 use `mh-current-folder'.
|
56406
|
606
|
67758
|
607 If DEFAULT is a string then use that as default range to return. If
|
|
608 DEFAULT is nil then ask user with default answer a range based on the
|
|
609 sequences that seem relevant. Finally if DEFAULT is t, try to avoid
|
|
610 prompting the user. Unseen messages, if present, are returned. If the
|
|
611 folder has fewer than `mh-large-folder' messages then \"all\" messages
|
|
612 are returned. Finally as a last resort prompt the user.
|
56406
|
613
|
67758
|
614 If EXPAND-FLAG is non-nil then a list of message numbers corresponding
|
|
615 to the input is returned. If this list is empty then an error is
|
|
616 raised. If EXPAND-FLAG is nil just return the input string. In this
|
|
617 case we don't check if the range is empty.
|
56406
|
618
|
|
619 If ASK-FLAG is non-nil, then the user is always queried for a range of
|
67758
|
620 messages. If ASK-FLAG is nil, then the function checks if the unseen
|
|
621 sequence is non-empty. If that is the case, `mh-unseen-seq', or the
|
|
622 list of messages in it depending on the value of EXPAND, is returned.
|
|
623 Otherwise if the folder has fewer than `mh-large-folder' messages then
|
|
624 the list of messages corresponding to \"all\" is returned. If neither
|
|
625 of the above holds then as a last resort the user is queried for a
|
|
626 range of messages.
|
56406
|
627
|
67758
|
628 If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as
|
|
629 input, it is interpreted as the range \"last:N\".
|
56406
|
630
|
67758
|
631 This function replaces the existing function `mh-read-msg-range'.
|
|
632 Calls to:
|
|
633
|
56406
|
634 (mh-read-msg-range folder flag)
|
67758
|
635
|
56406
|
636 should be replaced with:
|
67758
|
637
|
56406
|
638 (mh-read-range \"Suitable prompt\" folder t nil flag
|
|
639 mh-interpret-number-as-range-flag)"
|
|
640 (setq default (or default mh-last-seq-used
|
|
641 (car (mh-seq-containing-msg (mh-get-msg-num nil) t)))
|
|
642 prompt (format "%s range" prompt))
|
|
643 (let* ((folder (or folder mh-current-folder))
|
|
644 (guess (eq default t))
|
|
645 (counts (and guess (mh-folder-size folder)))
|
|
646 (unseen (and counts (> (cadr counts) 0)))
|
|
647 (large (and counts mh-large-folder (> (car counts) mh-large-folder)))
|
68012
|
648 (default (cond ((and guess large) (format "last:%s" mh-large-folder))
|
|
649 ((and guess (not large)) "all")
|
|
650 ((stringp default) default)
|
|
651 ((symbolp default) (symbol-name default))))
|
|
652 (prompt (cond ((and guess large default)
|
|
653 (format "%s (folder has %s messages, default %s)"
|
|
654 prompt (car counts) default))
|
|
655 ((and guess large)
|
|
656 (format "%s (folder has %s messages)"
|
|
657 prompt (car counts)))
|
|
658 (default
|
|
659 (format "%s (default %s)" prompt default))))
|
56406
|
660 (minibuffer-local-completion-map mh-range-completion-map)
|
|
661 (seq-list (if (eq folder mh-current-folder)
|
|
662 mh-seq-list
|
|
663 (mh-read-folder-sequences folder nil)))
|
|
664 (mh-range-seq-names
|
|
665 (append '(("first") ("last") ("all") ("prev") ("next"))
|
|
666 (mh-seq-names seq-list)))
|
|
667 (input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq))
|
|
668 ((and (not ask-flag) (not large)) "all")
|
68012
|
669 (t (completing-read (format "%s: " prompt)
|
56406
|
670 'mh-range-completion-function nil nil
|
|
671 nil 'mh-range-history default))))
|
|
672 msg-list)
|
|
673 (when (and number-as-range-flag
|
|
674 (string-match "^[ \t]*\\([0-9]+\\)[ \t]*$" input))
|
|
675 (setq input (concat "last:" (match-string 1 input))))
|
|
676 (cond ((not expand-flag) input)
|
|
677 ((assoc (intern input) seq-list)
|
|
678 (cdr (assoc (intern input) seq-list)))
|
|
679 ((setq msg-list (mh-translate-range folder input)) msg-list)
|
68013
|
680 (t (error "No messages in range %s" input)))))
|
56406
|
681
|
|
682 ;;;###mh-autoload
|
68465
|
683 (defun mh-range-to-msg-list (range)
|
|
684 "Return a list of messages for RANGE.
|
|
685
|
|
686 Check the documentation of `mh-interactive-range' to see how
|
|
687 RANGE is read in interactive use."
|
|
688 (let (msg-list)
|
|
689 (mh-iterate-on-range msg range
|
|
690 (push msg msg-list))
|
|
691 (nreverse msg-list)))
|
|
692
|
|
693 ;;;###mh-autoload
|
56406
|
694 (defun mh-translate-range (folder expr)
|
|
695 "In FOLDER, translate the string EXPR to a list of messages numbers."
|
|
696 (save-excursion
|
|
697 (let ((strings (delete "" (split-string expr "[ \t\n]")))
|
|
698 (result ()))
|
|
699 (ignore-errors
|
|
700 (apply #'mh-exec-cmd-quiet nil "mhpath" folder strings)
|
|
701 (set-buffer mh-temp-buffer)
|
|
702 (goto-char (point-min))
|
|
703 (while (re-search-forward "/\\([0-9]*\\)$" nil t)
|
68212
|
704 (push (string-to-number (match-string 1)) result))
|
56406
|
705 (nreverse result)))))
|
|
706
|
68465
|
707 (defun mh-range-completion-function (string predicate flag)
|
|
708 "Programmable completion of message ranges.
|
|
709 STRING is the user input that is to be completed. PREDICATE if non-nil is a
|
|
710 function used to filter the possible choices and FLAG determines whether the
|
|
711 completion is over."
|
|
712 (let* ((candidates mh-range-seq-names)
|
|
713 (last-char (and (not (equal string ""))
|
|
714 (aref string (1- (length string)))))
|
|
715 (last-word (cond ((null last-char) "")
|
|
716 ((memq last-char '(? ?- ?:)) "")
|
|
717 (t (car (last (split-string string "[ -:]+"))))))
|
|
718 (prefix (substring string 0 (- (length string) (length last-word)))))
|
|
719 (cond ((eq flag nil)
|
|
720 (let ((res (try-completion last-word candidates predicate)))
|
|
721 (cond ((null res) nil)
|
|
722 ((eq res t) t)
|
|
723 (t (concat prefix res)))))
|
|
724 ((eq flag t)
|
|
725 (all-completions last-word candidates predicate))
|
|
726 ((eq flag 'lambda)
|
|
727 (loop for x in candidates
|
|
728 when (equal x last-word) return t
|
|
729 finally return nil)))))
|
|
730
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
731 (defun mh-seq-names (seq-list)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
732 "Return an alist containing the names of the SEQ-LIST."
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
733 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
734 seq-list))
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
735
|
68465
|
736 (defun mh-folder-size (folder)
|
|
737 "Find size of FOLDER."
|
|
738 (if mh-flists-present-flag
|
|
739 (mh-folder-size-flist folder)
|
|
740 (mh-folder-size-folder folder)))
|
|
741
|
|
742 (defun mh-folder-size-flist (folder)
|
|
743 "Find size of FOLDER using \"flist\"."
|
|
744 (with-temp-buffer
|
|
745 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
|
|
746 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
|
|
747 (goto-char (point-min))
|
|
748 (multiple-value-bind (folder unseen total)
|
|
749 (mh-parse-flist-output-line
|
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
diff
changeset
|
750 (buffer-substring (point) (mh-line-end-position)))
|
68465
|
751 (values total unseen folder))))
|
|
752
|
|
753 (defun mh-folder-size-folder (folder)
|
|
754 "Find size of FOLDER using \"folder\"."
|
|
755 (with-temp-buffer
|
|
756 (let ((u (length (cdr (assoc mh-unseen-seq
|
|
757 (mh-read-folder-sequences folder nil))))))
|
|
758 (call-process (expand-file-name "folder" mh-progs) nil t nil
|
|
759 "-norecurse" folder)
|
|
760 (goto-char (point-min))
|
|
761 (if (re-search-forward " has \\([0-9]+\\) " nil t)
|
|
762 (values (string-to-number (match-string 1)) u folder)
|
|
763 (values 0 u folder)))))
|
|
764
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
765 ;;;###mh-autoload
|
68465
|
766 (defun mh-parse-flist-output-line (line &optional current-folder)
|
|
767 "Parse LINE to generate folder name, unseen messages and total messages.
|
|
768 If CURRENT-FOLDER is non-nil then it contains the current folder
|
|
769 name and it is used to avoid problems in corner cases involving
|
|
770 folders whose names end with a '+' character."
|
|
771 (with-temp-buffer
|
|
772 (insert line)
|
|
773 (goto-char (point-max))
|
|
774 (let (folder unseen total p)
|
|
775 (when (search-backward " out of " (point-min) t)
|
|
776 (setq total (string-to-number
|
|
777 (buffer-substring-no-properties
|
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
diff
changeset
|
778 (match-end 0) (mh-line-end-position))))
|
68465
|
779 (when (search-backward " in sequence " (point-min) t)
|
|
780 (setq p (point))
|
|
781 (when (search-backward " has " (point-min) t)
|
|
782 (setq unseen (string-to-number (buffer-substring-no-properties
|
|
783 (match-end 0) p)))
|
|
784 (while (eq (char-after) ? )
|
|
785 (backward-char))
|
|
786 (setq folder (buffer-substring-no-properties
|
|
787 (point-min) (1+ (point))))
|
|
788 (when (and (equal (aref folder (1- (length folder))) ?+)
|
|
789 (equal current-folder folder))
|
|
790 (setq folder (substring folder 0 (1- (length folder)))))
|
|
791 (values (format "+%s" folder) unseen total)))))))
|
|
792
|
|
793 ;;;###mh-autoload
|
|
794 (defun mh-read-folder-sequences (folder save-refiles)
|
|
795 "Read and return the predefined sequences for a FOLDER.
|
|
796 If SAVE-REFILES is non-nil, then keep the sequences
|
|
797 that note messages to be refiled."
|
|
798 (let ((seqs ()))
|
|
799 (cond (save-refiles
|
|
800 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
|
|
801 (if (mh-folder-name-p (mh-seq-name seq))
|
|
802 (setq seqs (cons seq seqs)))))
|
|
803 mh-seq-list)))
|
|
804 (save-excursion
|
|
805 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
|
|
806 (progn
|
|
807 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
|
|
808 (while (re-search-forward "^[^: ]+" nil t)
|
|
809 (setq seqs (cons (mh-make-seq (intern (buffer-substring
|
|
810 (match-beginning 0)
|
|
811 (match-end 0)))
|
|
812 (mh-read-msg-list))
|
|
813 seqs)))
|
|
814 (delete-region (point-min) (point))))) ; avoid race with
|
|
815 ; mh-process-daemon
|
|
816 seqs))
|
|
817
|
|
818 (defun mh-read-msg-list ()
|
|
819 "Return a list of message numbers from point to the end of the line.
|
|
820 Expands ranges into set of individual numbers."
|
|
821 (let ((msgs ())
|
|
822 (end-of-line (save-excursion (end-of-line) (point)))
|
|
823 num)
|
|
824 (while (re-search-forward "[0-9]+" end-of-line t)
|
|
825 (setq num (string-to-number (buffer-substring (match-beginning 0)
|
|
826 (match-end 0))))
|
|
827 (cond ((looking-at "-") ; Message range
|
|
828 (forward-char 1)
|
|
829 (re-search-forward "[0-9]+" end-of-line t)
|
|
830 (let ((num2 (string-to-number
|
|
831 (buffer-substring (match-beginning 0)
|
|
832 (match-end 0)))))
|
|
833 (if (< num2 num)
|
|
834 (error "Bad message range: %d-%d" num num2))
|
|
835 (while (<= num num2)
|
|
836 (setq msgs (cons num msgs))
|
|
837 (setq num (1+ num)))))
|
|
838 ((not (zerop num)) ;"pick" outputs "0" to mean no match
|
|
839 (setq msgs (cons num msgs)))))
|
|
840 msgs))
|
|
841
|
|
842
|
|
843
|
|
844 ;;; Notation
|
|
845
|
|
846 ;;;###mh-autoload
|
|
847 (defun mh-notate (msg notation offset)
|
|
848 "Mark MSG with the character NOTATION at position OFFSET.
|
|
849 Null MSG means the message at cursor.
|
|
850 If NOTATION is nil then no change in the buffer occurs."
|
|
851 (save-excursion
|
|
852 (if (or (null msg)
|
|
853 (mh-goto-msg msg t t))
|
|
854 (with-mh-folder-updating (t)
|
|
855 (beginning-of-line)
|
|
856 (forward-char offset)
|
|
857 (let* ((change-stack-flag
|
|
858 (and (equal offset
|
|
859 (+ mh-cmd-note mh-scan-field-destination-offset))
|
|
860 (not (eq notation mh-note-seq))))
|
|
861 (msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
|
|
862 (stack (and msg (gethash msg mh-sequence-notation-history)))
|
|
863 (notation (or notation (char-after))))
|
|
864 (if stack
|
|
865 ;; The presence of the stack tells us that we don't need to
|
|
866 ;; notate the message, since the notation would be replaced
|
|
867 ;; by a sequence notation. So we will just put the notation
|
|
868 ;; at the bottom of the stack. If the sequence is deleted,
|
|
869 ;; the correct notation will be shown.
|
|
870 (setf (gethash msg mh-sequence-notation-history)
|
|
871 (reverse (cons notation (cdr (reverse stack)))))
|
|
872 ;; Since we don't have any sequence notations in the way, just
|
|
873 ;; notate the scan line.
|
|
874 (delete-char 1)
|
|
875 (insert notation))
|
|
876 (when change-stack-flag
|
|
877 (mh-thread-update-scan-line-map msg notation offset)))))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
878
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
879 ;;;###mh-autoload
|
49578
|
880 (defun mh-notate-cur ()
|
|
881 "Mark the MH sequence cur.
|
67758
|
882 In addition to notating the current message with `mh-note-cur'
|
|
883 the function uses `overlay-arrow-position' to put a marker in the
|
|
884 fringe."
|
49578
|
885 (let ((cur (car (mh-seq-to-msgs 'cur))))
|
|
886 (when (and cur (mh-goto-msg cur t t))
|
|
887 (beginning-of-line)
|
50702
|
888 (when (looking-at mh-scan-good-msg-regexp)
|
|
889 (mh-notate nil mh-note-cur mh-cmd-note))
|
49578
|
890 (setq mh-arrow-marker (set-marker mh-arrow-marker (point)))
|
|
891 (setq overlay-arrow-position mh-arrow-marker))))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
892
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
893 ;;;###mh-autoload
|
68465
|
894 (defun mh-remove-cur-notation ()
|
|
895 "Remove old cur notation."
|
|
896 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
|
|
897 (save-excursion
|
|
898 (when (and cur-msg
|
|
899 (mh-goto-msg cur-msg t t)
|
|
900 (looking-at mh-scan-cur-msg-number-regexp))
|
|
901 (mh-notate nil ? mh-cmd-note)
|
|
902 (setq overlay-arrow-position nil)))))
|
49578
|
903
|
68465
|
904 ;; FIXME? We may want to clear all notations and add one for current-message
|
|
905 ;; and process user sequences.
|
50702
|
906 ;;;###mh-autoload
|
68465
|
907 (defun mh-notate-deleted-and-refiled ()
|
|
908 "Notate messages marked for deletion or refiling.
|
|
909 Messages to be deleted are given by `mh-delete-list' while
|
|
910 messages to be refiled are present in `mh-refile-list'."
|
|
911 (let ((refiled-hash (make-hash-table))
|
|
912 (deleted-hash (make-hash-table)))
|
|
913 (dolist (msg mh-delete-list)
|
|
914 (setf (gethash msg deleted-hash) t))
|
|
915 (dolist (dest-msg-list mh-refile-list)
|
|
916 (dolist (msg (cdr dest-msg-list))
|
|
917 (setf (gethash msg refiled-hash) t)))
|
|
918 (mh-iterate-on-messages-in-region msg (point-min) (point-max)
|
|
919 (cond ((gethash msg refiled-hash)
|
|
920 (mh-notate nil mh-note-refiled mh-cmd-note))
|
|
921 ((gethash msg deleted-hash)
|
|
922 (mh-notate nil mh-note-deleted mh-cmd-note))))))
|
50702
|
923
|
|
924 ;;;###mh-autoload
|
68465
|
925 (defun mh-notate-user-sequences (&optional range)
|
|
926 "Mark user-defined sequences in RANGE.
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
927
|
68465
|
928 Check the documentation of `mh-interactive-range' to see how
|
|
929 RANGE is read in interactive use; if nil all messages are
|
|
930 notated."
|
|
931 (unless range
|
|
932 (setq range (cons (point-min) (point-max))))
|
|
933 (let ((seqs mh-seq-list)
|
|
934 (msg-hash (make-hash-table)))
|
|
935 (dolist (seq seqs)
|
|
936 (dolist (msg (mh-seq-msgs seq))
|
|
937 (push (car seq) (gethash msg msg-hash))))
|
|
938 (mh-iterate-on-range msg range
|
|
939 (loop for seq in (gethash msg msg-hash)
|
|
940 do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
|
56406
|
941
|
68465
|
942 (defun mh-add-sequence-notation (msg internal-seq-flag)
|
|
943 "Add sequence notation to the MSG on the current line.
|
|
944 If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if
|
|
945 font-lock is turned on."
|
|
946 (with-mh-folder-updating (t)
|
|
947 (save-excursion
|
|
948 (beginning-of-line)
|
|
949 (if internal-seq-flag
|
|
950 (progn
|
|
951 ;; Change the buffer so that if transient-mark-mode is active
|
|
952 ;; and there is an active region it will get deactivated as in
|
|
953 ;; the case of user sequences.
|
|
954 (mh-notate nil nil mh-cmd-note)
|
|
955 (when font-lock-mode
|
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
diff
changeset
|
956 (font-lock-fontify-region (point) (mh-line-end-position))))
|
68465
|
957 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
|
|
958 (let ((stack (gethash msg mh-sequence-notation-history)))
|
|
959 (setf (gethash msg mh-sequence-notation-history)
|
|
960 (cons (char-after) stack)))
|
|
961 (mh-notate nil mh-note-seq
|
|
962 (+ mh-cmd-note mh-scan-field-destination-offset))))))
|
67758
|
963
|
68465
|
964 (defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
|
|
965 "Remove sequence notation from the MSG on the current line.
|
|
966 If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to
|
|
967 highlight the sequence. In that case, no notation needs to be removed.
|
|
968 Otherwise the effect of inserting `mh-note-seq' needs to be reversed.
|
|
969 If ALL is non-nil, then all sequence marks on the scan line are
|
|
970 removed."
|
|
971 (with-mh-folder-updating (t)
|
|
972 ;; This takes care of internal sequences...
|
|
973 (mh-notate nil nil mh-cmd-note)
|
|
974 (unless internal-seq-flag
|
|
975 ;; ... and this takes care of user sequences.
|
|
976 (let ((stack (gethash msg mh-sequence-notation-history)))
|
|
977 (while (and all (cdr stack))
|
|
978 (setq stack (cdr stack)))
|
|
979 (when stack
|
|
980 (save-excursion
|
|
981 (beginning-of-line)
|
|
982 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
|
|
983 (delete-char 1)
|
|
984 (insert (car stack))))
|
|
985 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
|
62847
|
986
|
56406
|
987 ;;;###mh-autoload
|
68465
|
988 (defun mh-remove-all-notation ()
|
|
989 "Remove all notations on all scan lines that MH-E introduces."
|
|
990 (save-excursion
|
|
991 (setq overlay-arrow-position nil)
|
|
992 (goto-char (point-min))
|
|
993 (mh-iterate-on-range msg (cons (point-min) (point-max))
|
|
994 (mh-notate nil ? mh-cmd-note)
|
|
995 (mh-remove-sequence-notation msg nil t))
|
|
996 (clrhash mh-sequence-notation-history)))
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
997
|
67681
|
998
|
|
999
|
68465
|
1000 ;; XXX Unused, delete, or create bind key?
|
|
1001 (defun mh-rename-seq (sequence new-name)
|
|
1002 "Rename SEQUENCE to have NEW-NAME."
|
|
1003 (interactive (list (mh-read-seq "Old" t)
|
|
1004 (intern (read-string "New sequence name: "))))
|
|
1005 (let ((old-seq (mh-find-seq sequence)))
|
|
1006 (or old-seq
|
|
1007 (error "Sequence %s does not exist" sequence))
|
|
1008 ;; Create new sequence first, since it might raise an error.
|
|
1009 (mh-define-sequence new-name (mh-seq-msgs old-seq))
|
|
1010 (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
|
|
1011 (rplaca old-seq new-name)))
|
50702
|
1012
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1013 (provide 'mh-seq)
|
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1014
|
67681
|
1015 ;; Local Variables:
|
|
1016 ;; indent-tabs-mode: nil
|
|
1017 ;; sentence-end-double-space: nil
|
|
1018 ;; End:
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1019
|
67681
|
1020 ;; arch-tag: 8e952711-01a2-485b-bf21-c9e3ad4de942
|
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1021 ;;; mh-seq.el ends here
|