comparison lisp/mh-e/mh-seq.el @ 56673:e9a6cbc8ca5e

Upgraded to MH-E version 7.4.80. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.

56672:83ab2b01744a

;;; Change Log:

;;; Code:

(require 'mh-utils)
(mh-require-cl)
(require 'mh-e)

;; Shush the byte-compiler
(defvar tool-bar-mode)

;;; Data structures (used in message threading)...
(defstruct (mh-thread-message (:conc-name mh-message-)
                              (:constructor mh-thread-make-message))
  (id nil)
  (references ())
  (subject "")
  (subject-re-p nil))

(defstruct (mh-thread-container (:conc-name mh-container-)
                                (:constructor mh-thread-make-container))
  message parent children
  (real-child-p t))


;;; Internal variables:

        (setq view-exit-action 'kill-buffer)
        (message "Listing sequences...done")))))

;;;###mh-autoload
(defun mh-msg-is-in-seq (message)
  "Display the sequences that contain MESSAGE.
Default is the displayed message."
  (interactive (list (mh-get-msg-num t)))
  (let* ((dest-folder (loop for seq in mh-refile-list
                            until (member message (cdr seq))
                            finally return (car seq)))
         (deleted-flag (unless dest-folder (member message mh-delete-list))))
    (message "Message %d%s is in sequences: %s"
             message
             (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
                   (deleted-flag (format " (to be deleted)"))

  (unless (mh-valid-seq-p sequence)
    (error "Can't put message in invalid sequence `%s'" sequence))
  (let* ((internal-seq-flag (mh-internal-seq sequence))
         (original-msgs (mh-seq-msgs (mh-find-seq sequence)))
         (folders (list mh-current-folder))
         (msg-list ()))
    (mh-iterate-on-range m range
      (push m msg-list)
      (unless (memq m original-msgs)
        (mh-add-sequence-notation m internal-seq-flag)))
    (mh-add-msgs-to-seq msg-list sequence nil t)
    (if (not internal-seq-flag)
        (setq mh-last-seq-used sequence))
    (when mh-index-data
      (setq folders
            (append folders (mh-index-add-to-sequence sequence msg-list))))

         (pop mh-view-ops))
        (t nil)))

;;;###mh-autoload
(defun mh-widen (&optional all-flag)
  "Remove last restriction from current folder.
If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning
of the view stack thereby showing all messages that the buffer originally
contained."
  (interactive "P")
  (let ((msg (mh-get-msg-num nil)))
    (when mh-folder-view-stack
      (cond (all-flag
             (while (cdr mh-view-ops)

    (mh-define-sequence new-name (mh-seq-msgs old-seq))
    (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
    (rplaca old-seq new-name)))

;;;###mh-autoload
(defun mh-map-to-seq-msgs (func seq &rest args)
  "Invoke the FUNC at each message in the SEQ.
SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
passed as arguments to FUNC."
  (save-excursion
    (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
      (while msgs
        (if (mh-goto-msg (car msgs) t t)
            (apply func (car msgs) args))
        (setq msgs (cdr msgs))))))

;;;###mh-autoload
(defun mh-notate-seq (seq notation offset)
  "Mark the scan listing.
All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
the line."
  (let ((msg-list (mh-seq-to-msgs seq)))
    (mh-iterate-on-messages-in-region msg (point-min) (point-max)
      (when (member msg msg-list)
        (mh-notate nil notation offset)))))

;;;###mh-autoload
(defun mh-notate-cur ()
  "Mark the MH sequence cur.
In addition to notating the current message with `mh-note-cur' the function
uses `overlay-arrow-position' to put a marker in the fringe."
  (let ((cur (car (mh-seq-to-msgs 'cur))))

  (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
      (if msgs
          (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
                 "-sequence" (symbol-name seq)
                 (mh-coalesce-msg-list msgs)))))

;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
;; that the folder buffer is sorted. However in this case that assumption
;; doesn't hold. So we will do this the dumb way.
;(defun mh-copy-seq-to-point (seq location)
;  ;; Copy the scan listing of the messages in SEQUENCE to after the point
;  ;; LOCATION in the current buffer.
;  (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))

(defvar mh-thread-last-ancestor)

(defun mh-copy-seq-to-eob (seq)
  "Copy SEQ to the end of the buffer."

               (mh-thread-print-scan-lines
                (mh-thread-generate mh-current-folder ()))
               (mh-notate-user-sequences))
              (mh-index-data
               (mh-index-insert-folder-headers)))))))

(defun mh-copy-line-to-point (msg location)
  "Copy current message line to a specific location.
The argument MSG is not used. The message in the current line is copied to
LOCATION."
  ;; msg is not used?
  ;; Copy the current line to the LOCATION in the current buffer.
  (beginning-of-line)
  (save-excursion
    (let ((beginning-of-line (point))
          end)
      (forward-line 1)
      (setq end (point))
      (goto-char location)
      (insert-buffer-substring (current-buffer) beginning-of-line end))))

;;;###mh-autoload
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
  "Iterate over region.
VAR is bound to the message on the current line as we loop starting from BEGIN

    (mh-iterate-on-range msg range
      (push msg msg-list))
    (nreverse msg-list)))

;;;###mh-autoload
(defun mh-interactive-range (range-prompt)
  "Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.

If variable `transient-mark-mode' is non-nil and the mark is active, then this
function returns a cons-cell of the region.

If optional prefix argument is provided, then prompt for message range with
RANGE-PROMPT. A list of messages in that range is returned.

If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.

Otherwise, the message number at point is returned.

This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions."
  (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
        (current-prefix-arg (mh-read-range range-prompt nil nil t t))
        (t (mh-get-msg-num t))))

;;;###mh-autoload
(defun mh-region-to-msg-list (begin end)
  "Return a list of messages within the region between BEGIN and END."
  ;; If end is end of buffer back up one position
  (setq end (if (equal end (point-max)) (1- end) end))
  (let ((result))
    (mh-iterate-on-messages-in-region index begin end
      (when (numberp index) (push index result)))
    result))



;;; Commands to handle new 'subject sequence.
;;; Or "Poor man's threading" by psg.

  (save-excursion
    (beginning-of-line)
    (if (or (not (looking-at mh-scan-subject-regexp))
            (not (match-string 3))
            (string-equal "" (match-string 3)))
        (progn (message "No subject line.")
               nil)
      (let ((subject (match-string-no-properties 3))
            (list))
        (if (> (length subject) 41)
            (setq subject (substring subject 0 41)))

  (ignore-errors
    (mh-message-subject
     (mh-container-message (gethash (gethash msg mh-thread-index-id-map)
                                    mh-thread-id-table)))))

;;;###mh-autoload
(defun mh-narrow-to-subject ()
  "Narrow to a sequence containing all following messages with same subject."
  (interactive)
  (let ((num (mh-get-msg-num nil))
        (count (mh-subject-to-sequence t)))
    (cond
     ((not count)                       ; No subject line, delete msg anyway
      nil)
     ((= 0 count)                       ; No other msgs, delete msg anyway.
      (message "No other messages with same Subject following this one.")
      nil)
     (t                                 ; We have a subject sequence.
      (message "Found %d messages for subject sequence." count)
      (mh-narrow-to-seq 'subject)
      (if (numberp num)
          (mh-goto-msg num t t))))))

(defun mh-read-pick-regexp (default)
  "With prefix arg read a pick regexp.
If no prefix arg is given, then return DEFAULT."
  (let ((default-string (loop for x in default concat (format " %s" x))))
    (if (or current-prefix-arg (equal default-string ""))
        (delete "" (split-string (read-string "Pick regexp: " default-string)))
      default)))

;;;###mh-autoload
(defun mh-narrow-to-from (&optional regexp)
  "Limit to messages with the same From header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
  (interactive
   (list (mh-read-pick-regexp (mh-current-message-header-field 'from))))
  (mh-narrow-to-header-field 'from regexp))

;;;###mh-autoload
(defun mh-narrow-to-cc (&optional regexp)
  "Limit to messages with the same Cc header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
  (interactive
   (list (mh-read-pick-regexp (mh-current-message-header-field 'cc))))
  (mh-narrow-to-header-field 'cc regexp))

;;;###mh-autoload
(defun mh-narrow-to-to (&optional regexp)
  "Limit to messages with the same To header field as the message at point.
With a prefix argument, prompt for the regular expression, REGEXP given to
pick."
  (interactive
   (list (mh-read-pick-regexp (mh-current-message-header-field 'to))))
  (mh-narrow-to-header-field 'to regexp))

(defun mh-narrow-to-header-field (header-field regexp)
  "Limit to messages whose HEADER-FIELD match REGEXP.
The MH command pick is used to do the match."
  (let ((folder mh-current-folder)
        (original (mh-coalesce-msg-list
                   (mh-range-to-msg-list (cons (point-min) (point-max)))))
        (msg-list ()))
    (with-temp-buffer
      (apply #'mh-exec-cmd-output "pick" nil folder
             (append original (list "-list") regexp))
      (goto-char (point-min))
      (while (not (eobp))
        (let ((num (read-from-string
                    (buffer-substring (point) (line-end-position)))))
          (when (numberp (car num)) (push (car num) msg-list))

;;;###mh-autoload
(defun mh-narrow-to-range (range)
  "Limit to messages in RANGE.

Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use."
  (interactive (list (mh-interactive-range "Narrow to")))
  (when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
  (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
  (mh-narrow-to-seq 'range))

  (let ((count (mh-subject-to-sequence nil)))
    (cond
     ((not count)                       ; No subject line, delete msg anyway
      (mh-delete-msg (mh-get-msg-num t)))
     ((= 0 count)                       ; No other msgs, delete msg anyway.
      (message "No other messages with same Subject following this one.")
      (mh-delete-msg (mh-get-msg-num t)))
     (t                                 ; We have a subject sequence.
      (message "Marked %d messages for deletion" count)
      (mh-delete-msg 'subject)))))

           (setf (mh-message-id message) id)
           (setf (mh-message-references message) refs)
           message)
          (container
           (setf (mh-container-message container)
                 (mh-thread-make-message :subject subject
                                         :subject-re-p subject-re-p
                                         :id id :references refs)))
          (t (let ((message (mh-thread-make-message
                             :subject subject
                             :subject-re-p subject-re-p
                             :id id :references refs)))
               (prog1 message
                 (mh-thread-get-message-container message)))))))

(defsubst mh-thread-canonicalize-id (id)
  "Produce canonical string representation for ID.

MSG is the message being notated with NOTATION at OFFSET."
  (let* ((msg (or msg (mh-get-msg-num nil)))
         (cur-scan-line (and mh-thread-scan-line-map
                             (gethash msg mh-thread-scan-line-map)))
         (old-scan-lines (loop for map in mh-thread-scan-line-map-stack
                               collect (and map (gethash msg map))))
         (notation (if (stringp notation) (aref notation 0) notation)))
    (when cur-scan-line
      (setf (aref (car cur-scan-line) offset) notation))
    (dolist (line old-scan-lines)
      (when line (setf (aref (car line) offset) notation)))))

                       do (let ((v (gethash msg old-map)))
                            (when v
                              (setf (gethash msg mh-thread-scan-line-map) v))))
                 (when (> (hash-table-count mh-thread-scan-line-map) 0)
                   (insert (if (bobp) "" "\n") (car x) "\n")
                   (mh-thread-generate-scan-lines thread-tree -2)))))))

(defun mh-thread-folder ()
  "Generate thread view of folder."
  (message "Threading %s..." (buffer-name))
  (mh-thread-initialize)

    (mh-iterate-on-range msg range
      (cond ((member msg tick-seq-msgs)
             (push msg unticked)
             (setcdr tick-seq (delq msg (cdr tick-seq)))
             (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
             (mh-remove-sequence-notation msg t))
            (t
             (push msg ticked)
             (setq mh-last-seq-used mh-tick-seq)
             (mh-add-sequence-notation msg t))))
    (mh-add-msgs-to-seq ticked mh-tick-seq nil t)
    (mh-undefine-sequence mh-tick-seq unticked)
    (when mh-index-data
      (mh-index-add-to-sequence mh-tick-seq ticked)
      (mh-index-delete-from-sequence mh-tick-seq unticked))))

;;;###mh-autoload
(defun mh-narrow-to-tick ()
  "Restrict display of this folder to just messages in `mh-tick-seq'.
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive)
  (cond ((not mh-tick-seq)
         (error "Enable ticking by customizing `mh-tick-seq'"))
        ((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
         (message "No messages in tick sequence"))
        (t (mh-narrow-to-seq mh-tick-seq))))


(provide 'mh-seq)

;;; Local Variables:
;;; indent-tabs-mode: nil

56673:e9a6cbc8ca5e

;;; Change Log:

;;; Code:

(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-e)

;; Shush the byte-compiler
(defvar tool-bar-mode)

;;; Data structures (used in message threading)...
(mh-defstruct (mh-thread-message (:conc-name mh-message-)
                                 (:constructor mh-thread-make-message))
  (id nil)
  (references ())
  (subject "")
  (subject-re-p nil))

(mh-defstruct (mh-thread-container (:conc-name mh-container-)
                                   (:constructor mh-thread-make-container))
  message parent children
  (real-child-p t))


;;; Internal variables:

        (setq view-exit-action 'kill-buffer)
        (message "Listing sequences...done")))))

;;;###mh-autoload
(defun mh-msg-is-in-seq (message)
  "Display the sequences in which the current message appears.
Use a prefix argument to display the sequences in which another MESSAGE
appears."
  (interactive "P")
  (if (not message)
      (setq message (mh-get-msg-num t)))
  (let* ((dest-folder (loop for seq in mh-refile-list
                            when (member message (cdr seq)) return (car seq)
                            finally return nil))
         (deleted-flag (unless dest-folder (member message mh-delete-list))))
    (message "Message %d%s is in sequences: %s"
             message
             (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
                   (deleted-flag (format " (to be deleted)"))

  (unless (mh-valid-seq-p sequence)
    (error "Can't put message in invalid sequence `%s'" sequence))
  (let* ((internal-seq-flag (mh-internal-seq sequence))
         (original-msgs (mh-seq-msgs (mh-find-seq sequence)))
         (folders (list mh-current-folder))
         (msg-list (mh-range-to-msg-list range)))
    (mh-add-msgs-to-seq msg-list sequence nil t)
    (mh-iterate-on-range m range
      (unless (memq m original-msgs)
        (mh-add-sequence-notation m internal-seq-flag)))
    (if (not internal-seq-flag)
        (setq mh-last-seq-used sequence))
    (when mh-index-data
      (setq folders
            (append folders (mh-index-add-to-sequence sequence msg-list))))

         (pop mh-view-ops))
        (t nil)))

;;;###mh-autoload
(defun mh-widen (&optional all-flag)
  "Restore the previous limit.
If optional prefix argument ALL-FLAG is non-nil, remove all limits."
  (interactive "P")
  (let ((msg (mh-get-msg-num nil)))
    (when mh-folder-view-stack
      (cond (all-flag
             (while (cdr mh-view-ops)

    (mh-define-sequence new-name (mh-seq-msgs old-seq))
    (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
    (rplaca old-seq new-name)))

;;;###mh-autoload
(defun mh-notate-cur ()
  "Mark the MH sequence cur.
In addition to notating the current message with `mh-note-cur' the function
uses `overlay-arrow-position' to put a marker in the fringe."
  (let ((cur (car (mh-seq-to-msgs 'cur))))

  (if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
      (if msgs
          (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
                 "-sequence" (symbol-name seq)
                 (mh-coalesce-msg-list msgs)))))

(defvar mh-thread-last-ancestor)

(defun mh-copy-seq-to-eob (seq)
  "Copy SEQ to the end of the buffer."

               (mh-thread-print-scan-lines
                (mh-thread-generate mh-current-folder ()))
               (mh-notate-user-sequences))
              (mh-index-data
               (mh-index-insert-folder-headers)))))))

;;;###mh-autoload
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
  "Iterate over region.
VAR is bound to the message on the current line as we loop starting from BEGIN

    (mh-iterate-on-range msg range
      (push msg msg-list))
    (nreverse msg-list)))

;;;###mh-autoload
(defun mh-interactive-range (range-prompt &optional default)
  "Return interactive specification for message, sequence, range or region.
By convention, the name of this argument is RANGE.

If variable `transient-mark-mode' is non-nil and the mark is active, then this
function returns a cons-cell of the region.

If optional prefix argument is provided, then prompt for message range with
RANGE-PROMPT. A list of messages in that range is returned.

If a MH range is given, say something like last:20, then a list containing
the messages in that range is returned.

If DEFAULT non-nil then it is returned.

Otherwise, the message number at point is returned.

This function is usually used with `mh-iterate-on-range' in order to provide
a uniform interface to MH-E functions."
  (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end)))
        (current-prefix-arg (mh-read-range range-prompt nil nil t t))
        (default default)
        (t (mh-get-msg-num t))))



;;; Commands to handle new 'subject sequence.
;;; Or "Poor man's threading" by psg.

  (save-excursion
    (beginning-of-line)
    (if (or (not (looking-at mh-scan-subject-regexp))
            (not (match-string 3))
            (string-equal "" (match-string 3)))
        (progn (message "No subject line")
               nil)
      (let ((subject (match-string-no-properties 3))
            (list))
        (if (> (length subject) 41)
            (setq subject (substring subject 0 41)))

  (ignore-errors
    (mh-message-subject
     (mh-container-message (gethash (gethash msg mh-thread-index-id-map)
                                    mh-thread-id-table)))))

(defun mh-edit-pick-expr (default)
  "With prefix arg edit a pick expression.
If no prefix arg is given, then return DEFAULT."
  (let ((default-string (loop for x in default concat (format " %s" x))))
    (if (or current-prefix-arg (equal default-string ""))
        (delete "" (split-string (read-string "Pick expression: "
                                              default-string)))
      default)))

;;;###mh-autoload
(defun mh-narrow-to-subject (&optional pick-expr)
  "Limit to messages with same subject.
With a prefix argument, edit PICK-EXPR.

Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive
   (list (mh-edit-pick-expr (mh-current-message-header-field 'subject))))
  (mh-narrow-to-header-field 'subject pick-expr))

;;;###mh-autoload
(defun mh-narrow-to-from (&optional pick-expr)
  "Limit to messages with the same `From:' field.
With a prefix argument, edit PICK-EXPR.

Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive
   (list (mh-edit-pick-expr (mh-current-message-header-field 'from))))
  (mh-narrow-to-header-field 'from pick-expr))

;;;###mh-autoload
(defun mh-narrow-to-cc (&optional pick-expr)
  "Limit to messages with the same `Cc:' field.
With a prefix argument, edit PICK-EXPR.

Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive
   (list (mh-edit-pick-expr (mh-current-message-header-field 'cc))))
  (mh-narrow-to-header-field 'cc pick-expr))

;;;###mh-autoload
(defun mh-narrow-to-to (&optional pick-expr)
  "Limit to messages with the same `To:' field.
With a prefix argument, edit PICK-EXPR.

Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive
   (list (mh-edit-pick-expr (mh-current-message-header-field 'to))))
  (mh-narrow-to-header-field 'to pick-expr))

(defun mh-narrow-to-header-field (header-field pick-expr)
  "Limit to messages whose HEADER-FIELD match PICK-EXPR.
The MH command pick is used to do the match."
  (let ((folder mh-current-folder)
        (original (mh-coalesce-msg-list
                   (mh-range-to-msg-list (cons (point-min) (point-max)))))
        (msg-list ()))
    (with-temp-buffer
      (apply #'mh-exec-cmd-output "pick" nil folder
             (append original (list "-list") pick-expr))
      (goto-char (point-min))
      (while (not (eobp))
        (let ((num (read-from-string
                    (buffer-substring (point) (line-end-position)))))
          (when (numberp (car num)) (push (car num) msg-list))

;;;###mh-autoload
(defun mh-narrow-to-range (range)
  "Limit to messages in RANGE.

Check the documentation of `mh-interactive-range' to see how RANGE is read in
interactive use.

Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive (list (mh-interactive-range "Narrow to")))
  (when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
  (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
  (mh-narrow-to-seq 'range))

  (let ((count (mh-subject-to-sequence nil)))
    (cond
     ((not count)                       ; No subject line, delete msg anyway
      (mh-delete-msg (mh-get-msg-num t)))
     ((= 0 count)                       ; No other msgs, delete msg anyway.
      (message "No other messages with same Subject following this one")
      (mh-delete-msg (mh-get-msg-num t)))
     (t                                 ; We have a subject sequence.
      (message "Marked %d messages for deletion" count)
      (mh-delete-msg 'subject)))))

           (setf (mh-message-id message) id)
           (setf (mh-message-references message) refs)
           message)
          (container
           (setf (mh-container-message container)
                 (mh-thread-make-message :id id :references refs
                                         :subject subject
                                         :subject-re-p subject-re-p)))
          (t (let ((message (mh-thread-make-message :id id :references refs
                                                    :subject-re-p subject-re-p
                                                    :subject subject)))
               (prog1 message
                 (mh-thread-get-message-container message)))))))

(defsubst mh-thread-canonicalize-id (id)
  "Produce canonical string representation for ID.

MSG is the message being notated with NOTATION at OFFSET."
  (let* ((msg (or msg (mh-get-msg-num nil)))
         (cur-scan-line (and mh-thread-scan-line-map
                             (gethash msg mh-thread-scan-line-map)))
         (old-scan-lines (loop for map in mh-thread-scan-line-map-stack
                               collect (and map (gethash msg map)))))
    (when cur-scan-line
      (setf (aref (car cur-scan-line) offset) notation))
    (dolist (line old-scan-lines)
      (when line (setf (aref (car line) offset) notation)))))

                       do (let ((v (gethash msg old-map)))
                            (when v
                              (setf (gethash msg mh-thread-scan-line-map) v))))
                 (when (> (hash-table-count mh-thread-scan-line-map) 0)
                   (insert (if (bobp) "" "\n") (car x) "\n")
                   (mh-thread-generate-scan-lines thread-tree -2))))
      (mh-index-create-imenu-index))))

(defun mh-thread-folder ()
  "Generate thread view of folder."
  (message "Threading %s..." (buffer-name))
  (mh-thread-initialize)

    (mh-iterate-on-range msg range
      (cond ((member msg tick-seq-msgs)
             (push msg unticked)
             (setcdr tick-seq (delq msg (cdr tick-seq)))
             (when (null (cdr tick-seq)) (setq mh-last-seq-used nil))
             (mh-remove-sequence-notation msg (mh-colors-in-use-p)))
            (t
             (push msg ticked)
             (setq mh-last-seq-used mh-tick-seq)
             (let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list)))
               (mh-add-sequence-notation msg (mh-colors-in-use-p))))))
    (mh-add-msgs-to-seq ticked mh-tick-seq nil t)
    (mh-undefine-sequence mh-tick-seq unticked)
    (when mh-index-data
      (mh-index-add-to-sequence mh-tick-seq ticked)
      (mh-index-delete-from-sequence mh-tick-seq unticked))))

;;;###mh-autoload
(defun mh-narrow-to-tick ()
  "Limit to messages in `mh-tick-seq'.

Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
  (interactive)
  (cond ((not mh-tick-seq)
         (error "Enable ticking by customizing `mh-tick-seq'"))
        ((null (mh-seq-msgs (mh-find-seq mh-tick-seq)))
         (message "No messages in %s sequence" mh-tick-seq))
        (t (mh-narrow-to-seq mh-tick-seq))))

(provide 'mh-seq)

;;; Local Variables:
;;; indent-tabs-mode: nil