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