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