1 ;;; mh-seq --- mh-e sequences support
2 ;; Time-stamp: <94/12/22 20:34:50 gildea>
4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
6 ;; This file is part of GNU Emacs.
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to
20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 ;; Internal support for mh-e package.
28 ;; $Id: mh-seq.el,v 1.2 1995/04/09 22:29:49 kwzh Exp kwzh $
35 ;;; Internal variables:
37 (defvar mh-last-seq-used nil) ;Name of seq to which a msg was last added.
39 (defvar mh-non-seq-mode-line-annotation nil) ;Saved value of mh-mode-line-annotation when narrowed to a seq.
42 (defun mh-delete-seq (sequence)
43 "Delete the SEQUENCE."
44 (interactive (list (mh-read-seq-default "Delete" t)))
45 (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
47 (mh-undefine-sequence sequence '("all"))
48 (mh-delete-seq-locally sequence))
51 (defun mh-list-sequences (folder)
52 "List the sequences defined in FOLDER."
53 (interactive (list (mh-prompt-for-folder "List sequences in"
54 mh-current-folder t)))
55 (let ((temp-buffer mh-temp-buffer)
56 (seq-list mh-seq-list))
57 (with-output-to-temp-buffer temp-buffer
59 (set-buffer temp-buffer)
61 (message "Listing sequences ...")
62 (insert "Sequences in folder " folder ":\n")
64 (let ((name (mh-seq-name (car seq-list)))
66 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))
67 (last-col (- (window-width) 4))
69 (insert (setq name-spec (format "%20s:" name)))
70 (while sorted-seq-msgs
71 (if (> (current-column) last-col)
74 (move-to-column (length name-spec))))
75 (insert (format " %s" (car sorted-seq-msgs)))
76 (setq sorted-seq-msgs (cdr sorted-seq-msgs)))
78 (setq seq-list (cdr seq-list)))
79 (goto-char (point-min))
80 (message "Listing sequences...done")))))
83 (defun mh-msg-is-in-seq (message)
84 "Display the sequences that contain MESSAGE (default: current message)."
85 (interactive (list (mh-get-msg-num t)))
86 (message "Message %d is in sequences: %s"
89 (mh-list-to-string (mh-seq-containing-msg message t))
93 (defun mh-narrow-to-seq (sequence)
94 "Restrict display of this folder to just messages in SEQUENCE.
95 Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
96 (interactive (list (mh-read-seq "Narrow to" t)))
97 (with-mh-folder-updating (t)
98 (cond ((mh-seq-to-msgs sequence)
100 (let ((eob (point-max)))
101 (mh-copy-seq-to-point sequence eob)
102 (narrow-to-region eob (point-max))
103 (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
104 (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
105 (setq mh-mode-line-annotation (symbol-name sequence))
106 (mh-make-folder-mode-line)
108 (setq mh-narrowed-to-seq sequence)))
110 (error "No messages in sequence `%s'" (symbol-name sequence))))))
113 (defun mh-put-msg-in-seq (msg-or-seq sequence)
114 "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
115 If optional prefix argument provided, then prompt for the message sequence."
116 (interactive (list (if current-prefix-arg
117 (mh-read-seq-default "Add messages from" t)
119 (mh-read-seq-default "Add to" nil)))
120 (if (not (mh-internal-seq sequence))
121 (setq mh-last-seq-used sequence))
122 (mh-add-msgs-to-seq (if (numberp msg-or-seq)
124 (mh-seq-to-msgs msg-or-seq))
129 "Remove restrictions from current folder, thereby showing all messages."
131 (if mh-narrowed-to-seq
132 (with-mh-folder-updating (t)
133 (delete-region (point-min) (point-max))
135 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
136 (mh-make-folder-mode-line)))
137 (setq mh-narrowed-to-seq nil))
141 ;;; Commands to manipulate sequences. Sequences are stored in an alist
143 ;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
146 (defun mh-read-seq-default (prompt not-empty)
147 ;; Read and return sequence name with default narrowed or previous sequence.
148 (mh-read-seq prompt not-empty
149 (or mh-narrowed-to-seq
151 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
154 (defun mh-read-seq (prompt not-empty &optional default)
155 ;; Read and return a sequence name. Prompt with PROMPT, raise an error
156 ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
157 ;; an optional DEFAULT sequence.
158 ;; A reply of '%' defaults to the first sequence containing the current
160 (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
162 (format "[%s] " default)
164 (mh-seq-names mh-seq-list)))
165 (seq (cond ((equal input "%")
166 (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
167 ((equal input "") default)
169 (msgs (mh-seq-to-msgs seq)))
170 (if (and (null msgs) not-empty)
171 (error (format "No messages in sequence `%s'" seq)))
175 (defun mh-seq-names (seq-list)
176 ;; Return an alist containing the names of the SEQUENCES.
177 (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
181 (defun mh-rename-seq (sequence new-name)
182 "Rename SEQUENCE to have NEW-NAME."
183 (interactive (list (mh-read-seq "Old" t)
184 (intern (read-string "New sequence name: "))))
185 (let ((old-seq (mh-find-seq sequence)))
187 (error "Sequence %s does not exist" sequence))
188 ;; create new sequence first, since it might raise an error.
189 (mh-define-sequence new-name (mh-seq-msgs old-seq))
190 (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
191 (rplaca old-seq new-name)))
194 (defun mh-map-to-seq-msgs (func seq &rest args)
195 ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
196 ;; remaining ARGS as arguments.
198 (let ((msgs (mh-seq-to-msgs seq)))
200 (if (mh-goto-msg (car msgs) t t)
201 (apply func (car msgs) args))
202 (setq msgs (cdr msgs))))))
205 (defun mh-notate-seq (seq notation offset)
206 ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
207 ;; at the given OFFSET from the beginning of the listing line.
208 (mh-map-to-seq-msgs 'mh-notate seq notation offset))
211 (defun mh-add-to-sequence (seq msgs)
212 ;; Add to a SEQUENCE each message the list of MSGS.
213 (if (not (mh-folder-name-p seq))
215 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
216 "-sequence" (symbol-name seq)
217 (mh-coalesce-msg-list msgs)))))
220 (defun mh-copy-seq-to-point (seq location)
221 ;; Copy the scan listing of the messages in SEQUENCE to after the point
222 ;; LOCATION in the current buffer.
223 (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
226 (defun mh-copy-line-to-point (msg location)
227 ;; Copy the current line to the LOCATION in the current buffer.
230 (let ((beginning-of-line (point))
235 (insert-buffer-substring (current-buffer) beginning-of-line end))))