1 ;;; mh-seq.el --- MH-E sequences support
3 ;; Copyright (C) 1993, 1995,
4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
5 ;; Free Software Foundation, Inc.
7 ;; Author: Bill Wohler <wohler@newt.com>
8 ;; Maintainer: Bill Wohler <wohler@newt.com>
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; Sequences are stored in the alist `mh-seq-list' in the form:
30 ;; ((seq-name msgs ...) (seq-name msgs ...) ...)
44 (defvar mh-last-seq-used nil
45 "Name of seq to which a msg was last added.")
47 (defvar mh-non-seq-mode-line-annotation nil
48 "Saved value of `mh-mode-line-annotation' when narrowed to a seq.")
49 (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
51 (defvar mh-internal-seqs '(answered cur deleted forwarded printed))
55 (defsubst mh-make-seq (name msgs)
56 "Create sequence NAME with the given MSGS."
59 (defsubst mh-seq-name (sequence)
60 "Extract sequence name from the given SEQUENCE."
65 ;;; MH-Folder Commands
70 (defun mh-catchup (range)
71 "Delete RANGE from the \"unseen\" sequence.
73 Check the documentation of `mh-interactive-range' to see how
74 RANGE is read in interactive use."
75 (interactive (list (mh-interactive-range "Catchup"
76 (cons (point-min) (point-max)))))
77 (mh-delete-msg-from-seq range mh-unseen-seq))
80 (defun mh-delete-msg-from-seq (range sequence &optional internal-flag)
81 "Delete RANGE from SEQUENCE.
83 Check the documentation of `mh-interactive-range' to see how
84 RANGE is read in interactive use.
86 In a program, non-nil INTERNAL-FLAG means do not inform MH of the
88 (interactive (list (mh-interactive-range "Delete")
89 (mh-read-seq-default "Delete from" t)
91 (let ((entry (mh-find-seq sequence))
92 (user-sequence-flag (not (mh-internal-seq sequence)))
93 (folders-changed (list mh-current-folder))
96 (mh-iterate-on-range msg range
98 ;; Calling "mark" repeatedly takes too long. So we will pretend here
99 ;; that we are just modifying an internal sequence...
100 (when (memq msg (cdr entry))
101 (mh-remove-sequence-notation msg (not user-sequence-flag)))
102 (mh-delete-a-msg-from-seq msg sequence t))
103 ;; ... and here we will "mark" all the messages at one go.
104 (unless internal-flag (mh-undefine-sequence sequence msg-list))
105 (when (and mh-index-data (not internal-flag))
106 (setq folders-changed
107 (append folders-changed
108 (mh-index-delete-from-sequence sequence msg-list))))
109 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
110 (apply #'mh-speed-flists t folders-changed)))))
113 (defun mh-delete-seq (sequence)
116 You are prompted for the sequence to delete. Note that this
117 deletes only the sequence, not the messages in the sequence. If
118 you want to delete the messages, use \"\\[universal-argument]
119 \\[mh-delete-msg]\"."
120 (interactive (list (mh-read-seq-default "Delete" t)))
121 (let ((msg-list (mh-seq-to-msgs sequence))
122 (internal-flag (mh-internal-seq sequence))
123 (folders-changed (list mh-current-folder)))
124 (mh-iterate-on-range msg sequence
125 (mh-remove-sequence-notation msg internal-flag))
126 (mh-undefine-sequence sequence '("all"))
127 (mh-delete-seq-locally sequence)
129 (setq folders-changed
130 (append folders-changed
131 (mh-index-delete-from-sequence sequence msg-list))))
132 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
133 (apply #'mh-speed-flists t folders-changed))))
136 (defvar view-exit-action)
139 (defun mh-list-sequences ()
140 "List all sequences in folder.
142 The list appears in a buffer named \"*MH-E Sequences*\"."
144 (let ((folder mh-current-folder)
145 (temp-buffer mh-sequences-buffer)
146 (seq-list mh-seq-list)
148 (with-output-to-temp-buffer temp-buffer
150 (set-buffer temp-buffer)
152 (message "Listing sequences ...")
153 (insert "Sequences in folder " folder ":\n")
154 (let ((seq-list seq-list))
157 (max (length (symbol-name (mh-seq-name (pop seq-list))))
159 (setq max-len (+ 2 max-len)))
161 (let ((name (mh-seq-name (car seq-list)))
163 (mh-coalesce-msg-list
164 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
166 (insert (setq name-spec (format (format "%%%ss:" max-len) name)))
167 (while sorted-seq-msgs
168 (let ((next-element (format " %s" (pop sorted-seq-msgs))))
169 (when (>= (+ (current-column) (length next-element))
172 (insert (format (format "%%%ss" (length name-spec)) "")))
173 (insert next-element)))
175 (setq seq-list (cdr seq-list)))
176 (goto-char (point-min))
178 (setq view-exit-action 'kill-buffer)
179 (message "Listing sequences...done")))))
182 (defun mh-msg-is-in-seq (message)
183 "Display the sequences in which the current message appears.
185 Use a prefix argument to display the sequences in which another
189 (setq message (mh-get-msg-num t)))
190 (let* ((dest-folder (loop for seq in mh-refile-list
191 when (member message (cdr seq)) return (car seq)
193 (deleted-flag (unless dest-folder (member message mh-delete-list))))
194 (message "Message %d%s is in sequences: %s"
196 (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
197 (deleted-flag (format " (to be deleted)"))
200 (mh-list-to-string (mh-seq-containing-msg message t))
204 (defvar tool-bar-mode) ; XEmacs
205 (defvar tool-bar-map)
208 (defun mh-narrow-to-seq (sequence)
209 "Restrict display to messages in SEQUENCE.
211 You are prompted for the name of the sequence. What this command
212 does is show only those messages that are in the selected
213 sequence in the MH-Folder buffer. In addition, it limits further
214 MH-E searches to just those messages.
216 When you want to widen the view to all your messages again, use
218 (interactive (list (mh-read-seq "Narrow to" t)))
219 (with-mh-folder-updating (t)
220 (cond ((mh-seq-to-msgs sequence)
221 (mh-remove-all-notation)
222 (let ((eob (point-max))
223 (msg-at-cursor (mh-get-msg-num nil)))
224 (push mh-thread-scan-line-map mh-thread-scan-line-map-stack)
225 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
226 (mh-copy-seq-to-eob sequence)
227 (push (buffer-substring-no-properties (point-min) eob)
228 mh-folder-view-stack)
229 (delete-region (point-min) eob)
230 (mh-notate-deleted-and-refiled)
232 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
233 (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
234 (setq mh-mode-line-annotation (symbol-name sequence))
235 (mh-make-folder-mode-line)
237 (when (and (boundp 'tool-bar-mode) tool-bar-mode)
238 (set (make-local-variable 'tool-bar-map)
239 mh-folder-seq-tool-bar-map)
240 (when (buffer-live-p (get-buffer mh-show-buffer))
241 (with-current-buffer mh-show-buffer
242 (set (make-local-variable 'tool-bar-map)
243 mh-show-seq-tool-bar-map))))
244 (push 'widen mh-view-ops)))
246 (error "No messages in sequence %s" (symbol-name sequence))))))
249 (defun mh-narrow-to-tick ()
250 "Limit to ticked messages.
252 What this command does is show only those messages that are in
253 the \"tick\" sequence (which you can customize via the
254 `mh-tick-seq' option) in the MH-Folder buffer. In addition, it
255 limits further MH-E searches to just those messages. When you
256 want to widen the view to all your messages again, use
259 (cond ((not mh-tick-seq)
260 (error "Enable ticking by customizing `mh-tick-seq'"))
261 ((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
262 (message "No messages in %s sequence" mh-tick-seq))
263 (t (mh-narrow-to-seq mh-tick-seq))))
266 (defun mh-put-msg-in-seq (range sequence)
267 "Add RANGE to SEQUENCE\\<mh-folder-mode-map>.
269 Give this command a RANGE and you can add all the messages in a
270 sequence to another sequence (for example,
271 \"\\[universal-argument] \\[mh-put-msg-in-seq] SourceSequence RET
272 DestSequence RET\"). Check the documentation of
273 `mh-interactive-range' to see how RANGE is read in interactive
275 (interactive (list (mh-interactive-range "Add messages from")
276 (mh-read-seq-default "Add to" nil)))
277 (unless (mh-valid-seq-p sequence)
278 (error "Can't put message in invalid sequence %s" sequence))
279 (let* ((internal-seq-flag (mh-internal-seq sequence))
280 (original-msgs (mh-seq-msgs (mh-find-seq sequence)))
281 (folders (list mh-current-folder))
282 (msg-list (mh-range-to-msg-list range)))
283 (mh-add-msgs-to-seq msg-list sequence nil t)
284 (mh-iterate-on-range m range
285 (unless (memq m original-msgs)
286 (mh-add-sequence-notation m internal-seq-flag)))
287 (if (not internal-seq-flag)
288 (setq mh-last-seq-used sequence))
291 (append folders (mh-index-add-to-sequence sequence msg-list))))
292 (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p))
293 (apply #'mh-speed-flists t folders))))
296 (defun mh-toggle-tick (range)
297 "Toggle tick mark of RANGE.
299 This command adds messages to the \"tick\" sequence (which you can customize
300 via the option `mh-tick-seq'). This sequence can be viewed later with the
301 \\[mh-index-ticked-messages] command.
303 Check the documentation of `mh-interactive-range' to see how RANGE is read in
305 (interactive (list (mh-interactive-range "Tick")))
307 (error "Enable ticking by customizing `mh-tick-seq'"))
308 (let* ((tick-seq (mh-find-seq mh-tick-seq))
309 (tick-seq-msgs (mh-seq-msgs tick-seq))
312 (mh-iterate-on-range msg range
313 (cond ((member msg tick-seq-msgs)
315 (setcdr tick-seq (delq msg (cdr tick-seq)))
316 (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
317 (mh-remove-sequence-notation msg (mh-colors-in-use-p)))
320 (setq mh-last-seq-used mh-tick-seq)
321 (let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list)))
322 (mh-add-sequence-notation msg (mh-colors-in-use-p))))))
323 (mh-add-msgs-to-seq ticked mh-tick-seq nil t)
324 (mh-undefine-sequence mh-tick-seq unticked)
326 (mh-index-add-to-sequence mh-tick-seq ticked)
327 (mh-index-delete-from-sequence mh-tick-seq unticked))))
330 (defun mh-widen (&optional all-flag)
331 "Remove last restriction.
333 Each limit or sequence restriction can be undone in turn with
334 this command. Give this command a prefix argument ALL-FLAG to
335 remove all limits and sequence restrictions."
337 (let ((msg (mh-get-msg-num nil)))
338 (when mh-folder-view-stack
340 (while (cdr mh-view-ops)
341 (setq mh-view-ops (cdr mh-view-ops)))
342 (when (eq (car mh-view-ops) 'widen)
343 (setq mh-view-ops (cdr mh-view-ops))))
344 ((mh-valid-view-change-operation-p 'widen) nil)
345 ((memq 'widen mh-view-ops)
346 (while (not (eq (car mh-view-ops) 'widen))
347 (setq mh-view-ops (cdr mh-view-ops)))
348 (setq mh-view-ops (cdr mh-view-ops)))
349 (t (error "Widening is not applicable")))
350 ;; If ALL-FLAG is non-nil then rewind stacks
352 (while (cdr mh-thread-scan-line-map-stack)
353 (setq mh-thread-scan-line-map-stack
354 (cdr mh-thread-scan-line-map-stack)))
355 (while (cdr mh-folder-view-stack)
356 (setq mh-folder-view-stack (cdr mh-folder-view-stack))))
357 (setq mh-thread-scan-line-map (pop mh-thread-scan-line-map-stack))
358 (with-mh-folder-updating (t)
359 (delete-region (point-min) (point-max))
360 (insert (pop mh-folder-view-stack))
361 (mh-remove-all-notation)
362 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
363 (mh-make-folder-mode-line))
365 (mh-goto-msg msg t t))
366 (mh-notate-deleted-and-refiled)
367 (mh-notate-user-sequences)
370 (when (and (null mh-folder-view-stack) (boundp 'tool-bar-mode) tool-bar-mode)
371 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)
372 (when (buffer-live-p (get-buffer mh-show-buffer))
373 (with-current-buffer mh-show-buffer
374 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)))))
380 (defvar mh-sequence-history ())
383 (defun mh-read-seq-default (prompt not-empty)
384 "Read and return sequence name with default narrowed or previous sequence.
385 PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil
386 then a non-empty sequence is read."
387 (mh-read-seq prompt not-empty
389 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
391 (defun mh-read-seq (prompt not-empty &optional default)
392 "Read and return a sequence name.
393 Prompt with PROMPT, raise an error if the sequence is empty and
394 the NOT-EMPTY flag is non-nil, and supply an optional DEFAULT
395 sequence. A reply of '%' defaults to the first sequence
396 containing the current message."
397 (let* ((input (completing-read (format "%s sequence%s: " prompt
399 (format " (default %s)" default)
401 (mh-seq-names mh-seq-list)
402 nil nil nil 'mh-sequence-history))
403 (seq (cond ((equal input "%")
404 (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
405 ((equal input "") default)
407 (msgs (mh-seq-to-msgs seq)))
408 (if (and (null msgs) not-empty)
409 (error "No messages in sequence %s" seq))
412 (defun mh-internal-seq (name)
413 "Return non-nil if NAME is the name of an internal MH-E sequence."
414 (or (memq name mh-internal-seqs)
415 (eq name mh-unseen-seq)
416 (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq))
417 (eq name mh-previous-seq)
418 (mh-folder-name-p name)))
421 (defun mh-valid-seq-p (name)
422 "Return non-nil if NAME is a valid MH sequence name."
424 (string-match "^[a-zA-Z][a-zA-Z0-9]*$" (symbol-name name))))
427 (defun mh-find-seq (name)
428 "Return sequence NAME."
429 (assoc name mh-seq-list))
432 (defun mh-seq-to-msgs (seq)
433 "Return a list of the messages in SEQ."
434 (mh-seq-msgs (mh-find-seq seq)))
436 (defun mh-seq-containing-msg (msg &optional include-internal-flag)
437 "Return a list of the sequences containing MSG.
438 If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences
440 (let ((l mh-seq-list)
443 (and (memq msg (mh-seq-msgs (car l)))
444 (or include-internal-flag
445 (not (mh-internal-seq (mh-seq-name (car l)))))
446 (setq seqs (cons (mh-seq-name (car l)) seqs)))
451 (defun mh-define-sequence (seq msgs)
452 "Define the SEQ to contain the list of MSGS.
453 Do not mark pseudo-sequences or empty sequences.
454 Signals an error if SEQ is an invalid name."
457 (not (mh-folder-name-p seq)))
459 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
460 "-sequence" (symbol-name seq)
461 (mh-coalesce-msg-list msgs)))))
464 (defun mh-undefine-sequence (seq msgs)
465 "Remove from the SEQ the list of MSGS."
466 (when (and (mh-valid-seq-p seq) msgs)
467 (apply #'mh-exec-cmd "mark" mh-current-folder "-delete"
468 "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))
471 (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag dont-annotate-flag)
474 Remove duplicates and keep sequence sorted. If optional
475 INTERNAL-FLAG is non-nil, do not mark the message in the scan
476 listing or inform MH of the addition.
478 If DONT-ANNOTATE-FLAG is non-nil then the annotations in the
479 folder buffer are not updated."
480 (let ((entry (mh-find-seq seq))
481 (internal-seq-flag (mh-internal-seq seq)))
482 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
485 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
487 (if msgs (setcdr entry (mh-canonicalize-sequence
488 (append msgs (mh-seq-msgs entry))))))
489 (unless internal-flag
490 (mh-add-to-sequence seq msgs)
491 (when (not dont-annotate-flag)
492 (mh-iterate-on-range msg msgs
493 (unless (memq msg (cdr entry))
494 (mh-add-sequence-notation msg internal-seq-flag)))))))
496 (defun mh-add-to-sequence (seq msgs)
497 "The sequence SEQ is augmented with the messages in MSGS."
498 ;; Add to a SEQUENCE each message the list of MSGS.
499 (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
501 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
502 "-sequence" (symbol-name seq)
503 (mh-coalesce-msg-list msgs)))))
505 (defun mh-canonicalize-sequence (msgs)
506 "Sort MSGS in decreasing order and remove duplicates."
507 (let* ((sorted-msgs (sort (copy-sequence msgs) '>))
510 (if (= (car head) (cadr head))
511 (setcdr head (cddr head))
512 (setq head (cdr head))))
515 (defun mh-delete-a-msg-from-seq (msg sequence internal-flag)
516 "Delete MSG from SEQUENCE.
517 If INTERNAL-FLAG is non-nil, then do not inform MH of the
519 (let ((entry (mh-find-seq sequence)))
520 (when (and entry (memq msg (mh-seq-msgs entry)))
521 (if (not internal-flag)
522 (mh-undefine-sequence sequence (list msg)))
523 (setcdr entry (delq msg (mh-seq-msgs entry))))))
525 (defun mh-delete-seq-locally (seq)
526 "Remove MH-E's record of SEQ."
527 (let ((entry (mh-find-seq seq)))
528 (setq mh-seq-list (delq entry mh-seq-list))))
530 (defun mh-copy-seq-to-eob (seq)
531 "Copy SEQ to the end of the buffer."
532 ;; It is quite involved to write something which will work at any place in
533 ;; the buffer, so we will write something which works only at the end of
534 ;; the buffer. If we ever need to insert sequences in the middle of the
535 ;; buffer, this will need to be fixed.
537 (let* ((msgs (mh-seq-to-msgs seq))
538 (coalesced-msgs (mh-coalesce-msg-list msgs)))
539 (goto-char (point-max))
541 (narrow-to-region (point) (point))
542 (mh-regenerate-headers coalesced-msgs t)
543 (cond ((memq 'unthread mh-view-ops)
544 ;; Populate restricted scan-line map
545 (mh-remove-all-notation)
546 (mh-iterate-on-range msg (cons (point-min) (point-max))
547 (setf (gethash msg mh-thread-scan-line-map)
548 (mh-thread-parse-scan-line)))
549 ;; Remove scan lines and read results from pre-computed tree
550 (delete-region (point-min) (point-max))
551 (mh-thread-print-scan-lines
552 (mh-thread-generate mh-current-folder ()))
553 (mh-notate-user-sequences))
555 (mh-index-insert-folder-headers)))))))
558 (defun mh-valid-view-change-operation-p (op)
559 "Check if the view change operation can be performed.
560 OP is one of 'widen and 'unthread."
561 (cond ((eq (car mh-view-ops) op)
569 (defvar mh-range-seq-names)
570 (defvar mh-range-history ())
571 (defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map))
572 (define-key mh-range-completion-map " " 'self-insert-command)
575 (defun mh-interactive-range (range-prompt &optional default)
576 "Return interactive specification for message, sequence, range or region.
577 By convention, the name of this argument is RANGE.
579 If variable `transient-mark-mode' is non-nil and the mark is active,
580 then this function returns a cons-cell of the region.
582 If optional prefix argument is provided, then prompt for message range
583 with RANGE-PROMPT. A list of messages in that range is returned.
585 If a MH range is given, say something like last:20, then a list
586 containing the messages in that range is returned.
588 If DEFAULT non-nil then it is returned.
590 Otherwise, the message number at point is returned.
592 This function is usually used with `mh-iterate-on-range' in order to
593 provide a uniform interface to MH-E functions."
594 (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
595 (current-prefix-arg (mh-read-range range-prompt nil nil t t))
597 (t (mh-get-msg-num t))))
600 (defun mh-read-range (prompt &optional folder default
601 expand-flag ask-flag number-as-range-flag)
602 "Read a message range with PROMPT.
604 If FOLDER is non-nil then a range is read from that folder, otherwise
605 use `mh-current-folder'.
607 If DEFAULT is a string then use that as default range to return. If
608 DEFAULT is nil then ask user with default answer a range based on the
609 sequences that seem relevant. Finally if DEFAULT is t, try to avoid
610 prompting the user. Unseen messages, if present, are returned. If the
611 folder has fewer than `mh-large-folder' messages then \"all\" messages
612 are returned. Finally as a last resort prompt the user.
614 If EXPAND-FLAG is non-nil then a list of message numbers corresponding
615 to the input is returned. If this list is empty then an error is
616 raised. If EXPAND-FLAG is nil just return the input string. In this
617 case we don't check if the range is empty.
619 If ASK-FLAG is non-nil, then the user is always queried for a range of
620 messages. If ASK-FLAG is nil, then the function checks if the unseen
621 sequence is non-empty. If that is the case, `mh-unseen-seq', or the
622 list of messages in it depending on the value of EXPAND, is returned.
623 Otherwise if the folder has fewer than `mh-large-folder' messages then
624 the list of messages corresponding to \"all\" is returned. If neither
625 of the above holds then as a last resort the user is queried for a
628 If NUMBER-AS-RANGE-FLAG is non-nil, then if a number, N is read as
629 input, it is interpreted as the range \"last:N\".
631 This function replaces the existing function `mh-read-msg-range'.
634 (mh-read-msg-range folder flag)
636 should be replaced with:
638 (mh-read-range \"Suitable prompt\" folder t nil flag
639 mh-interpret-number-as-range-flag)"
640 (setq default (or default mh-last-seq-used
641 (car (mh-seq-containing-msg (mh-get-msg-num nil) t)))
642 prompt (format "%s range" prompt))
643 (let* ((folder (or folder mh-current-folder))
644 (guess (eq default t))
645 (counts (and guess (mh-folder-size folder)))
646 (unseen (and counts (> (cadr counts) 0)))
647 (large (and counts mh-large-folder (> (car counts) mh-large-folder)))
648 (default (cond ((and guess large) (format "last:%s" mh-large-folder))
649 ((and guess (not large)) "all")
650 ((stringp default) default)
651 ((symbolp default) (symbol-name default))))
652 (prompt (cond ((and guess large default)
653 (format "%s (folder has %s messages, default %s)"
654 prompt (car counts) default))
656 (format "%s (folder has %s messages)"
657 prompt (car counts)))
659 (format "%s (default %s)" prompt default))))
660 (minibuffer-local-completion-map mh-range-completion-map)
661 (seq-list (if (eq folder mh-current-folder)
663 (mh-read-folder-sequences folder nil)))
665 (append '(("first") ("last") ("all") ("prev") ("next"))
666 (mh-seq-names seq-list)))
667 (input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq))
668 ((and (not ask-flag) (not large)) "all")
669 (t (completing-read (format "%s: " prompt)
670 'mh-range-completion-function nil nil
671 nil 'mh-range-history default))))
673 (when (and number-as-range-flag
674 (string-match "^[ \t]*\\([0-9]+\\)[ \t]*$" input))
675 (setq input (concat "last:" (match-string 1 input))))
676 (cond ((not expand-flag) input)
677 ((assoc (intern input) seq-list)
678 (cdr (assoc (intern input) seq-list)))
679 ((setq msg-list (mh-translate-range folder input)) msg-list)
680 (t (error "No messages in range %s" input)))))
683 (defun mh-range-to-msg-list (range)
684 "Return a list of messages for RANGE.
686 Check the documentation of `mh-interactive-range' to see how
687 RANGE is read in interactive use."
689 (mh-iterate-on-range msg range
691 (nreverse msg-list)))
694 (defun mh-translate-range (folder expr)
695 "In FOLDER, translate the string EXPR to a list of messages numbers."
697 (let ((strings (delete "" (split-string expr "[ \t\n]")))
700 (apply #'mh-exec-cmd-quiet nil "mhpath" folder strings)
701 (set-buffer mh-temp-buffer)
702 (goto-char (point-min))
703 (while (re-search-forward "/\\([0-9]*\\)$" nil t)
704 (push (string-to-number (match-string 1)) result))
705 (nreverse result)))))
707 (defun mh-range-completion-function (string predicate flag)
708 "Programmable completion of message ranges.
709 STRING is the user input that is to be completed. PREDICATE if non-nil is a
710 function used to filter the possible choices and FLAG determines whether the
712 (let* ((candidates mh-range-seq-names)
713 (last-char (and (not (equal string ""))
714 (aref string (1- (length string)))))
715 (last-word (cond ((null last-char) "")
716 ((memq last-char '(? ?- ?:)) "")
717 (t (car (last (split-string string "[ -:]+"))))))
718 (prefix (substring string 0 (- (length string) (length last-word)))))
720 (let ((res (try-completion last-word candidates predicate)))
721 (cond ((null res) nil)
723 (t (concat prefix res)))))
725 (all-completions last-word candidates predicate))
727 (loop for x in candidates
728 when (equal x last-word) return t
729 finally return nil)))))
731 (defun mh-seq-names (seq-list)
732 "Return an alist containing the names of the SEQ-LIST."
733 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
736 (defun mh-folder-size (folder)
737 "Find size of FOLDER."
738 (if mh-flists-present-flag
739 (mh-folder-size-flist folder)
740 (mh-folder-size-folder folder)))
742 (defun mh-folder-size-flist (folder)
743 "Find size of FOLDER using \"flist\"."
745 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
746 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
747 (goto-char (point-min))
748 (multiple-value-bind (folder unseen total)
750 (mh-parse-flist-output-line
751 (buffer-substring (point) (mh-line-end-position))))
752 (list total unseen folder))))
754 (defun mh-folder-size-folder (folder)
755 "Find size of FOLDER using \"folder\"."
757 (let ((u (length (cdr (assoc mh-unseen-seq
758 (mh-read-folder-sequences folder nil))))))
759 (call-process (expand-file-name "folder" mh-progs) nil t nil
761 (goto-char (point-min))
762 (if (re-search-forward " has \\([0-9]+\\) " nil t)
763 (list (string-to-number (match-string 1)) u folder)
764 (list 0 u folder)))))
767 (defun mh-parse-flist-output-line (line &optional current-folder)
768 "Parse LINE to generate folder name, unseen messages and total messages.
769 If CURRENT-FOLDER is non-nil then it contains the current folder
770 name and it is used to avoid problems in corner cases involving
771 folders whose names end with a '+' character."
774 (goto-char (point-max))
775 (let (folder unseen total p)
776 (when (search-backward " out of " (point-min) t)
777 (setq total (string-to-number
778 (buffer-substring-no-properties
779 (match-end 0) (mh-line-end-position))))
780 (when (search-backward " in sequence " (point-min) t)
782 (when (search-backward " has " (point-min) t)
783 (setq unseen (string-to-number (buffer-substring-no-properties
785 (while (eq (char-after) ? )
787 (setq folder (buffer-substring-no-properties
788 (point-min) (1+ (point))))
789 (when (and (equal (aref folder (1- (length folder))) ?+)
790 (equal current-folder folder))
791 (setq folder (substring folder 0 (1- (length folder)))))
792 (list (format "+%s" folder) unseen total)))))))
795 (defun mh-read-folder-sequences (folder save-refiles)
796 "Read and return the predefined sequences for a FOLDER.
797 If SAVE-REFILES is non-nil, then keep the sequences
798 that note messages to be refiled."
801 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
802 (if (mh-folder-name-p (mh-seq-name seq))
803 (setq seqs (cons seq seqs)))))
806 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
808 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
809 (while (re-search-forward "^[^: ]+" nil t)
810 (setq seqs (cons (mh-make-seq (intern (buffer-substring
815 (delete-region (point-min) (point))))) ; avoid race with
819 (defun mh-read-msg-list ()
820 "Return a list of message numbers from point to the end of the line.
821 Expands ranges into set of individual numbers."
823 (end-of-line (save-excursion (end-of-line) (point)))
825 (while (re-search-forward "[0-9]+" end-of-line t)
826 (setq num (string-to-number (buffer-substring (match-beginning 0)
828 (cond ((looking-at "-") ; Message range
830 (re-search-forward "[0-9]+" end-of-line t)
831 (let ((num2 (string-to-number
832 (buffer-substring (match-beginning 0)
835 (error "Bad message range: %d-%d" num num2))
837 (setq msgs (cons num msgs))
838 (setq num (1+ num)))))
839 ((not (zerop num)) ;"pick" outputs "0" to mean no match
840 (setq msgs (cons num msgs)))))
848 (defun mh-notate (msg notation offset)
849 "Mark MSG with the character NOTATION at position OFFSET.
850 Null MSG means the message at cursor.
851 If NOTATION is nil then no change in the buffer occurs."
854 (mh-goto-msg msg t t))
855 (with-mh-folder-updating (t)
857 (forward-char offset)
858 (let* ((change-stack-flag
860 (+ mh-cmd-note mh-scan-field-destination-offset))
861 (not (eq notation mh-note-seq))))
862 (msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
863 (stack (and msg (gethash msg mh-sequence-notation-history)))
864 (notation (or notation (char-after))))
866 ;; The presence of the stack tells us that we don't need to
867 ;; notate the message, since the notation would be replaced
868 ;; by a sequence notation. So we will just put the notation
869 ;; at the bottom of the stack. If the sequence is deleted,
870 ;; the correct notation will be shown.
871 (setf (gethash msg mh-sequence-notation-history)
872 (reverse (cons notation (cdr (reverse stack)))))
873 ;; Since we don't have any sequence notations in the way, just
874 ;; notate the scan line.
877 (when change-stack-flag
878 (mh-thread-update-scan-line-map msg notation offset)))))))
881 (defun mh-notate-cur ()
882 "Mark the MH sequence cur.
883 In addition to notating the current message with `mh-note-cur'
884 the function uses `overlay-arrow-position' to put a marker in the
886 (let ((cur (car (mh-seq-to-msgs 'cur))))
887 (when (and cur (mh-goto-msg cur t t))
889 (when (looking-at mh-scan-good-msg-regexp)
890 (mh-notate nil mh-note-cur mh-cmd-note))
891 (setq mh-arrow-marker (set-marker mh-arrow-marker (point)))
892 (setq overlay-arrow-position mh-arrow-marker))))
895 (defun mh-remove-cur-notation ()
896 "Remove old cur notation."
897 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
900 (mh-goto-msg cur-msg t t)
901 (looking-at mh-scan-cur-msg-number-regexp))
902 (mh-notate nil ? mh-cmd-note)
903 (setq overlay-arrow-position nil)))))
905 ;; FIXME? We may want to clear all notations and add one for current-message
906 ;; and process user sequences.
908 (defun mh-notate-deleted-and-refiled ()
909 "Notate messages marked for deletion or refiling.
910 Messages to be deleted are given by `mh-delete-list' while
911 messages to be refiled are present in `mh-refile-list'."
912 (let ((refiled-hash (make-hash-table))
913 (deleted-hash (make-hash-table)))
914 (dolist (msg mh-delete-list)
915 (setf (gethash msg deleted-hash) t))
916 (dolist (dest-msg-list mh-refile-list)
917 (dolist (msg (cdr dest-msg-list))
918 (setf (gethash msg refiled-hash) t)))
919 (mh-iterate-on-messages-in-region msg (point-min) (point-max)
920 (cond ((gethash msg refiled-hash)
921 (mh-notate nil mh-note-refiled mh-cmd-note))
922 ((gethash msg deleted-hash)
923 (mh-notate nil mh-note-deleted mh-cmd-note))))))
926 (defun mh-notate-user-sequences (&optional range)
927 "Mark user-defined sequences in RANGE.
929 Check the documentation of `mh-interactive-range' to see how
930 RANGE is read in interactive use; if nil all messages are
933 (setq range (cons (point-min) (point-max))))
934 (let ((seqs mh-seq-list)
935 (msg-hash (make-hash-table)))
937 (dolist (msg (mh-seq-msgs seq))
938 (push (car seq) (gethash msg msg-hash))))
939 (mh-iterate-on-range msg range
940 (loop for seq in (gethash msg msg-hash)
941 do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
943 (defun mh-add-sequence-notation (msg internal-seq-flag)
944 "Add sequence notation to the MSG on the current line.
945 If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if
946 font-lock is turned on."
947 (with-mh-folder-updating (t)
950 (if internal-seq-flag
952 ;; Change the buffer so that if transient-mark-mode is active
953 ;; and there is an active region it will get deactivated as in
954 ;; the case of user sequences.
955 (mh-notate nil nil mh-cmd-note)
957 (font-lock-fontify-region (point) (mh-line-end-position))))
958 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
959 (let ((stack (gethash msg mh-sequence-notation-history)))
960 (setf (gethash msg mh-sequence-notation-history)
961 (cons (char-after) stack)))
962 (mh-notate nil mh-note-seq
963 (+ mh-cmd-note mh-scan-field-destination-offset))))))
965 (defun mh-remove-sequence-notation (msg internal-seq-flag &optional all)
966 "Remove sequence notation from the MSG on the current line.
967 If INTERNAL-SEQ-FLAG is non-nil, then `font-lock' was used to
968 highlight the sequence. In that case, no notation needs to be removed.
969 Otherwise the effect of inserting `mh-note-seq' needs to be reversed.
970 If ALL is non-nil, then all sequence marks on the scan line are
972 (with-mh-folder-updating (t)
973 ;; This takes care of internal sequences...
974 (mh-notate nil nil mh-cmd-note)
975 (unless internal-seq-flag
976 ;; ... and this takes care of user sequences.
977 (let ((stack (gethash msg mh-sequence-notation-history)))
978 (while (and all (cdr stack))
979 (setq stack (cdr stack)))
983 (forward-char (+ mh-cmd-note mh-scan-field-destination-offset))
985 (insert (car stack))))
986 (setf (gethash msg mh-sequence-notation-history) (cdr stack))))))
989 (defun mh-remove-all-notation ()
990 "Remove all notations on all scan lines that MH-E introduces."
992 (setq overlay-arrow-position nil)
993 (goto-char (point-min))
994 (mh-iterate-on-range msg (cons (point-min) (point-max))
995 (mh-notate nil ? mh-cmd-note)
996 (mh-remove-sequence-notation msg nil t))
997 (clrhash mh-sequence-notation-history)))
1001 ;; XXX Unused, delete, or create bind key?
1002 (defun mh-rename-seq (sequence new-name)
1003 "Rename SEQUENCE to have NEW-NAME."
1004 (interactive (list (mh-read-seq "Old" t)
1005 (intern (read-string "New sequence name: "))))
1006 (let ((old-seq (mh-find-seq sequence)))
1008 (error "Sequence %s does not exist" sequence))
1009 ;; Create new sequence first, since it might raise an error.
1010 (mh-define-sequence new-name (mh-seq-msgs old-seq))
1011 (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
1012 (rplaca old-seq new-name)))
1017 ;; indent-tabs-mode: nil
1018 ;; sentence-end-double-space: nil
1021 ;; arch-tag: 8e952711-01a2-485b-bf21-c9e3ad4de942
1022 ;;; mh-seq.el ends here