[bpt/emacs.git] / lisp / mh-e / mh-limit.el

;;; mh-limit.el --- MH-E display limits

;; Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.

;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; "Poor man's threading" by psg.

;;; Change Log:

;;; Code:

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

(autoload 'message-fetch-field "message")

\f

;;; MH-Folder Commands

;; Alphabetical.

;;;###mh-autoload
(defun mh-delete-subject ()
  "Delete messages with same subject\\<mh-folder-mode-map>.

To delete messages faster, you can use this command to delete all
the messages with the same subject as the current message. This
command puts these messages in a sequence named \"subject\". You
can undo this action by using \\[mh-undo] with a prefix argument
and then specifying the \"subject\" sequence."
  (interactive)
  (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)))))

;;;###mh-autoload
(defun mh-delete-subject-or-thread ()
  "Delete messages with same subject or thread\\<mh-folder-mode-map>.

To delete messages faster, you can use this command to delete all
the messages with the same subject as the current message. This
command puts these messages in a sequence named \"subject\". You
can undo this action by using \\[mh-undo] with a prefix argument
and then specifying the \"subject\" sequence.

However, if the buffer is displaying a threaded view of the
folder then this command behaves like \\[mh-thread-delete]."
  (interactive)
  (if (memq 'unthread mh-view-ops)
      (mh-thread-delete)
    (mh-delete-subject)))

;;;###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-quote-pick-expr (mh-current-message-header-field 'cc)))))
  (mh-narrow-to-header-field 'cc 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-quote-pick-expr (mh-current-message-header-field 'from)))))
  (mh-narrow-to-header-field 'from pick-expr))

;;;###mh-autoload
(defun mh-narrow-to-range (range)
  "Limit to 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))

;;;###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-quote-pick-expr (mh-current-message-header-field 'subject)))))
  (mh-narrow-to-header-field 'subject 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-quote-pick-expr (mh-current-message-header-field 'to)))))
  (mh-narrow-to-header-field 'to pick-expr))

\f

;;; Support Routines

(defun mh-subject-to-sequence (all)
  "Put all following messages with same subject in sequence 'subject.
If arg ALL is t, move to beginning of folder buffer to collect all
messages.
If arg ALL is nil, collect only messages fron current one on forward.

Return number of messages put in the sequence:

 nil -> there was no subject line.

 0   -> there were no later messages with the same
        subject (sequence not made)

 >1  -> the total number of messages including current one."
  (if (memq 'unthread mh-view-ops)
      (mh-subject-to-sequence-threaded all)
    (mh-subject-to-sequence-unthreaded all)))

(defun mh-subject-to-sequence-threaded (all)
  "Put all messages with the same subject in the 'subject sequence.

This function works when the folder is threaded. In this
situation the subject could get truncated and so the normal
matching doesn't work.

The parameter ALL is non-nil then all the messages in the buffer
are considered, otherwise only the messages after the current one
are taken into account."
  (let* ((cur (mh-get-msg-num nil))
         (subject (mh-thread-find-msg-subject cur))
         region msgs)
    (if (null subject)
        (and (message "No subject line") nil)
      (setq region (cons (if all (point-min) (point)) (point-max)))
      (mh-iterate-on-range msg region
        (when (eq (mh-thread-find-msg-subject msg) subject)
          (push msg msgs)))
      (setq msgs (sort msgs #'mh-lessp))
      (if (null msgs)
          0
        (when (assoc 'subject mh-seq-list)
          (mh-delete-seq 'subject))
        (mh-add-msgs-to-seq msgs 'subject)
        (length msgs)))))

(defvar mh-limit-max-subject-size 41
  "Maximum size of the subject part.
It would be desirable to avoid hard-coding this.")

(defun mh-subject-to-sequence-unthreaded (all)
  "Put all following messages with same subject in sequence 'subject.

This function only works with an unthreaded folder. If arg ALL is
t, move to beginning of folder buffer to collect all messages. If
arg ALL is nil, collect only messages fron current one on
forward.

Return number of messages put in the sequence:

 nil -> there was no subject line.
 0   -> there were no later messages with the same
        subject (sequence not made)
 >1  -> the total number of messages including current one."
  (if (not (eq major-mode 'mh-folder-mode))
      (error "Not in a folder buffer"))
  (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 (mh-match-string-no-properties 3))
            (list))
        (if (> (length subject) mh-limit-max-subject-size)
            (setq subject (substring subject 0 mh-limit-max-subject-size)))
        (save-excursion
          (if all
              (goto-char (point-min)))
          (while (re-search-forward mh-scan-subject-regexp nil t)
            (let ((this-subject (mh-match-string-no-properties 3)))
              (if (> (length this-subject) mh-limit-max-subject-size)
                  (setq this-subject (substring this-subject
                                                0 mh-limit-max-subject-size)))
              (if (string-equal this-subject subject)
                  (setq list (cons (mh-get-msg-num t) list))))))
        (cond
         (list
          ;; If we created a new sequence, add the initial message to it too.
          (if (not (member (mh-get-msg-num t) list))
              (setq list (cons (mh-get-msg-num t) list)))
          (if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject))
          ;; sort the result into a sequence
          (let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
            (while sorted-list
              (mh-add-msgs-to-seq (car sorted-list) 'subject nil)
              (setq sorted-list (cdr sorted-list)))
            (safe-length list)))
         (t
          0))))))

(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 ""))
        (mh-pick-args-list (read-string "Pick expression: "
                                        default-string))
      default)))

(defun mh-pick-args-list (s)
  "Form list by grouping elements in string S suitable for pick arguments.
For example, the string \"-subject a b c -from Joe User
<user@domain.com>\" is converted to (\"-subject\" \"a b c\"
\"-from\" \"Joe User <user@domain.com>\""
  (let ((full-list (split-string s))
        current-arg collection arg-list)
    (while full-list
      (setq current-arg (car full-list))
      (if (null (string-match "^-" current-arg))
          (setq collection
                (if (null collection)
                    current-arg
                  (format "%s %s" collection current-arg)))
        (when collection
          (setq arg-list (append arg-list (list collection)))
          (setq collection nil))
        (setq arg-list (append arg-list (list current-arg))))
      (setq full-list (cdr full-list)))
    (when collection
      (setq arg-list (append arg-list (list collection))))
    arg-list))

(defun mh-current-message-header-field (header-field)
  "Return a pick regexp to match HEADER-FIELD of the message at point."
  (let ((num (mh-get-msg-num nil)))
    (when num
      (let ((folder mh-current-folder))
        (with-temp-buffer
          (insert-file-contents-literally (mh-msg-filename num folder))
          (goto-char (point-min))
          (when (search-forward "\n\n" nil t)
            (narrow-to-region (point-min) (point)))
          (let* ((field (or (message-fetch-field (format "%s" header-field))
                            ""))
                 (field-option (format "-%s" header-field))
                 (patterns (loop for x in (split-string  field "[ ]*,[ ]*")
                                 unless (equal x "")
                                 collect (if (string-match "<\\(.*@.*\\)>" x)
                                             (match-string 1 x)
                                           x))))
            (when patterns
              (loop with accum = `(,field-option ,(car patterns))
                    for e in (cdr patterns)
                    do (setq accum `(,field-option ,e "-or" ,@accum))
                    finally return accum))))))))

(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 (ignore-errors
                     (string-to-number
                      (buffer-substring (point) (mh-line-end-position))))))
          (when num (push num msg-list))
          (forward-line))))
    (if (null msg-list)
        (message "No matches")
      (when (assoc 'header mh-seq-list) (mh-delete-seq 'header))
      (mh-add-msgs-to-seq msg-list 'header)
      (mh-narrow-to-seq 'header))))

(provide 'mh-limit)

;; Local Variables:
;; indent-tabs-mode: nil
;; sentence-end-double-space: nil
;; End:

;; arch-tag: b0d24378-1234-4c42-aa3f-7abad25b40a1
;;; mh-limit.el ends here
Commit	Line	Data
dda00b2c BW	1	;;; mh-limit.el --- MH-E display limits
	2
	3	;; Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
	4
	5	;; Author: Peter S. Galbraith <psg@debian.org>
	6	;; Maintainer: Bill Wohler <wohler@newt.com>
	7	;; Keywords: mail
	8	;; See: mh-e.el
	9
	10	;; This file is part of GNU Emacs.
	11
	12	;; GNU Emacs is free software; you can redistribute it and/or modify
	13	;; it under the terms of the GNU General Public License as published by
	14	;; the Free Software Foundation; either version 2, or (at your option)
	15	;; any later version.
	16
	17	;; GNU Emacs is distributed in the hope that it will be useful,
	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
	23	;; along with GNU Emacs; see the file COPYING. If not, write to the
	24	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
	25	;; Boston, MA 02110-1301, USA.
	26
	27	;;; Commentary:
	28
	29	;; "Poor man's threading" by psg.
	30
	31	;;; Change Log:
	32
	33	;;; Code:
	34
	35	(require 'mh-e)
	36	(mh-require-cl)
	37	(require 'mh-scan)
	38
	39	(autoload 'message-fetch-field "message")
	40
	41	\f
	42
	43	;;; MH-Folder Commands
	44
	45	;; Alphabetical.
	46
	47	;;;###mh-autoload
	48	(defun mh-delete-subject ()
	49	"Delete messages with same subject\\<mh-folder-mode-map>.
	50
	51	To delete messages faster, you can use this command to delete all
	52	the messages with the same subject as the current message. This
	53	command puts these messages in a sequence named \"subject\". You
	54	can undo this action by using \\[mh-undo] with a prefix argument
	55	and then specifying the \"subject\" sequence."
	56	(interactive)
	57	(let ((count (mh-subject-to-sequence nil)))
	58	(cond
	59	((not count) ; No subject line, delete msg anyway
	60	(mh-delete-msg (mh-get-msg-num t)))
	61	((= 0 count) ; No other msgs, delete msg anyway.
	62	(message "No other messages with same Subject following this one")
	63	(mh-delete-msg (mh-get-msg-num t)))
	64	(t ; We have a subject sequence.
65	(message "Marked %d messages for deletion" count)
66	(mh-delete-msg 'subject)))))
67
68	;;;###mh-autoload
69	(defun mh-delete-subject-or-thread ()
70	"Delete messages with same subject or thread\\<mh-folder-mode-map>.
71
72	To delete messages faster, you can use this command to delete all
73	the messages with the same subject as the current message. This
74	command puts these messages in a sequence named \"subject\". You
75	can undo this action by using \\[mh-undo] with a prefix argument
76	and then specifying the \"subject\" sequence.
77
78	However, if the buffer is displaying a threaded view of the
79	folder then this command behaves like \\[mh-thread-delete]."
80	(interactive)
81	(if (memq 'unthread mh-view-ops)
82	(mh-thread-delete)
83	(mh-delete-subject)))
84
85	;;;###mh-autoload
86	(defun mh-narrow-to-cc (&optional pick-expr)
87	"Limit to messages with the same \"Cc:\" field.
88	With a prefix argument, edit PICK-EXPR.
89
90	Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
91	(interactive
052df334 BW	92	(list (mh-edit-pick-expr
052df334 BW	93	(mh-quote-pick-expr (mh-current-message-header-field 'cc)))))
dda00b2c BW	94	(mh-narrow-to-header-field 'cc pick-expr))
	95
	96	;;;###mh-autoload
	97	(defun mh-narrow-to-from (&optional pick-expr)
	98	"Limit to messages with the same \"From:\" field.
	99	With a prefix argument, edit PICK-EXPR.
	100
	101	Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
	102	(interactive
052df334 BW	103	(list (mh-edit-pick-expr
052df334 BW	104	(mh-quote-pick-expr (mh-current-message-header-field 'from)))))
dda00b2c BW	105	(mh-narrow-to-header-field 'from pick-expr))
	106
	107	;;;###mh-autoload
	108	(defun mh-narrow-to-range (range)
	109	"Limit to RANGE.
	110
	111	Check the documentation of `mh-interactive-range' to see how
	112	RANGE is read in interactive use.
	113
	114	Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
	115	(interactive (list (mh-interactive-range "Narrow to")))
	116	(when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
	117	(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
	118	(mh-narrow-to-seq 'range))
	119
	120	;;;###mh-autoload
	121	(defun mh-narrow-to-subject (&optional pick-expr)
	122	"Limit to messages with same subject.
	123	With a prefix argument, edit PICK-EXPR.
	124
	125	Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
	126	(interactive
052df334 BW	127	(list (mh-edit-pick-expr
052df334 BW	128	(mh-quote-pick-expr (mh-current-message-header-field 'subject)))))
dda00b2c BW	129	(mh-narrow-to-header-field 'subject pick-expr))
	130
	131	;;;###mh-autoload
	132	(defun mh-narrow-to-to (&optional pick-expr)
	133	"Limit to messages with the same \"To:\" field.
	134	With a prefix argument, edit PICK-EXPR.
	135
	136	Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
	137	(interactive
052df334 BW	138	(list (mh-edit-pick-expr
052df334 BW	139	(mh-quote-pick-expr (mh-current-message-header-field 'to)))))
dda00b2c BW	140	(mh-narrow-to-header-field 'to pick-expr))
	141
	142	\f
	143
	144	;;; Support Routines
	145
	146	(defun mh-subject-to-sequence (all)
	147	"Put all following messages with same subject in sequence 'subject.
	148	If arg ALL is t, move to beginning of folder buffer to collect all
	149	messages.
	150	If arg ALL is nil, collect only messages fron current one on forward.
	151
	152	Return number of messages put in the sequence:
	153
	154	nil -> there was no subject line.
	155
	156	0 -> there were no later messages with the same
	157	subject (sequence not made)
	158
	159	>1 -> the total number of messages including current one."
	160	(if (memq 'unthread mh-view-ops)
	161	(mh-subject-to-sequence-threaded all)
	162	(mh-subject-to-sequence-unthreaded all)))
	163
	164	(defun mh-subject-to-sequence-threaded (all)
	165	"Put all messages with the same subject in the 'subject sequence.
	166
	167	This function works when the folder is threaded. In this
	168	situation the subject could get truncated and so the normal
	169	matching doesn't work.
	170
	171	The parameter ALL is non-nil then all the messages in the buffer
	172	are considered, otherwise only the messages after the current one
	173	are taken into account."
	174	(let* ((cur (mh-get-msg-num nil))
	175	(subject (mh-thread-find-msg-subject cur))
	176	region msgs)
	177	(if (null subject)
	178	(and (message "No subject line") nil)
	179	(setq region (cons (if all (point-min) (point)) (point-max)))
	180	(mh-iterate-on-range msg region
	181	(when (eq (mh-thread-find-msg-subject msg) subject)
	182	(push msg msgs)))
	183	(setq msgs (sort msgs #'mh-lessp))
	184	(if (null msgs)
	185	0
	186	(when (assoc 'subject mh-seq-list)
	187	(mh-delete-seq 'subject))
	188	(mh-add-msgs-to-seq msgs 'subject)
	189	(length msgs)))))
	190
	191	(defvar mh-limit-max-subject-size 41
	192	"Maximum size of the subject part.
	193	It would be desirable to avoid hard-coding this.")
	194
	195	(defun mh-subject-to-sequence-unthreaded (all)
	196	"Put all following messages with same subject in sequence 'subject.
	197
	198	This function only works with an unthreaded folder. If arg ALL is
	199	t, move to beginning of folder buffer to collect all messages. If
	200	arg ALL is nil, collect only messages fron current one on
	201	forward.
	202
	203	Return number of messages put in the sequence:
204
205	nil -> there was no subject line.
206	0 -> there were no later messages with the same
207	subject (sequence not made)
208	>1 -> the total number of messages including current one."
209	(if (not (eq major-mode 'mh-folder-mode))
210	(error "Not in a folder buffer"))
211	(save-excursion
212	(beginning-of-line)
213	(if (or (not (looking-at mh-scan-subject-regexp))
214	(not (match-string 3))
215	(string-equal "" (match-string 3)))
216	(progn (message "No subject line")
217	nil)
d5dc8c56	218	(let ((subject (mh-match-string-no-properties 3))
dda00b2c BW	219	(list))
	220	(if (> (length subject) mh-limit-max-subject-size)
	221	(setq subject (substring subject 0 mh-limit-max-subject-size)))
	222	(save-excursion
	223	(if all
	224	(goto-char (point-min)))
	225	(while (re-search-forward mh-scan-subject-regexp nil t)
d5dc8c56	226	(let ((this-subject (mh-match-string-no-properties 3)))
dda00b2c BW	227	(if (> (length this-subject) mh-limit-max-subject-size)
	228	(setq this-subject (substring this-subject
	229	0 mh-limit-max-subject-size)))
	230	(if (string-equal this-subject subject)
	231	(setq list (cons (mh-get-msg-num t) list))))))
	232	(cond
	233	(list
	234	;; If we created a new sequence, add the initial message to it too.
	235	(if (not (member (mh-get-msg-num t) list))
	236	(setq list (cons (mh-get-msg-num t) list)))
	237	(if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject))
	238	;; sort the result into a sequence
	239	(let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
	240	(while sorted-list
	241	(mh-add-msgs-to-seq (car sorted-list) 'subject nil)
	242	(setq sorted-list (cdr sorted-list)))
	243	(safe-length list)))
	244	(t
	245	0))))))
	246
	247	(defun mh-edit-pick-expr (default)
	248	"With prefix arg edit a pick expression.
	249	If no prefix arg is given, then return DEFAULT."
	250	(let ((default-string (loop for x in default concat (format " %s" x))))
	251	(if (or current-prefix-arg (equal default-string ""))
	252	(mh-pick-args-list (read-string "Pick expression: "
	253	default-string))
	254	default)))
	255
	256	(defun mh-pick-args-list (s)
	257	"Form list by grouping elements in string S suitable for pick arguments.
	258	For example, the string \"-subject a b c -from Joe User
	259	<user@domain.com>\" is converted to (\"-subject\" \"a b c\"
	260	\"-from\" \"Joe User <user@domain.com>\""
	261	(let ((full-list (split-string s))
	262	current-arg collection arg-list)
	263	(while full-list
	264	(setq current-arg (car full-list))
	265	(if (null (string-match "^-" current-arg))
	266	(setq collection
	267	(if (null collection)
	268	current-arg
	269	(format "%s %s" collection current-arg)))
	270	(when collection
	271	(setq arg-list (append arg-list (list collection)))
	272	(setq collection nil))
	273	(setq arg-list (append arg-list (list current-arg))))
	274	(setq full-list (cdr full-list)))
	275	(when collection
	276	(setq arg-list (append arg-list (list collection))))
	277	arg-list))
	278
	279	(defun mh-current-message-header-field (header-field)
	280	"Return a pick regexp to match HEADER-FIELD of the message at point."
	281	(let ((num (mh-get-msg-num nil)))
	282	(when num
	283	(let ((folder mh-current-folder))
	284	(with-temp-buffer
	285	(insert-file-contents-literally (mh-msg-filename num folder))
	286	(goto-char (point-min))
	287	(when (search-forward "\n\n" nil t)
	288	(narrow-to-region (point-min) (point)))
	289	(let* ((field (or (message-fetch-field (format "%s" header-field))
	290	""))
291	(field-option (format "-%s" header-field))
292	(patterns (loop for x in (split-string field "[ ],[ ]")
293	unless (equal x "")
294	collect (if (string-match "<\\(.@.\\)>" x)
295	(match-string 1 x)
296	x))))
297	(when patterns
298	(loop with accum = `(,field-option ,(car patterns))
299	for e in (cdr patterns)
300	do (setq accum `(,field-option ,e "-or" ,@accum))
301	finally return accum))))))))
302
303	(defun mh-narrow-to-header-field (header-field pick-expr)
304	"Limit to messages whose HEADER-FIELD match PICK-EXPR.
305	The MH command pick is used to do the match."
306	(let ((folder mh-current-folder)
307	(original (mh-coalesce-msg-list
308	(mh-range-to-msg-list (cons (point-min) (point-max)))))
309	(msg-list ()))
310	(with-temp-buffer
311	(apply #'mh-exec-cmd-output "pick" nil folder
312	(append original (list "-list") pick-expr))
313	(goto-char (point-min))
314	(while (not (eobp))
315	(let ((num (ignore-errors
316	(string-to-number
d5dc8c56	317	(buffer-substring (point) (mh-line-end-position))))))
dda00b2c BW	318	(when num (push num msg-list))
	319	(forward-line))))
	320	(if (null msg-list)
	321	(message "No matches")
	322	(when (assoc 'header mh-seq-list) (mh-delete-seq 'header))
	323	(mh-add-msgs-to-seq msg-list 'header)
	324	(mh-narrow-to-seq 'header))))
	325
	326	(provide 'mh-limit)
	327
	328	;; Local Variables:
	329	;; indent-tabs-mode: nil
	330	;; sentence-end-double-space: nil
	331	;; End:
	332
a1ab640d	333	;; arch-tag: b0d24378-1234-4c42-aa3f-7abad25b40a1
dda00b2c	334	;;; mh-limit.el ends here