Commit | Line | Data |
---|---|---|
c26cf6c8 | 1 | ;;; mh-seq --- mh-e sequences support |
b4b1e78a | 2 | ;; Time-stamp: <95/08/19 16:45:15 gildea> |
c26cf6c8 | 3 | |
847b8219 | 4 | ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. |
c26cf6c8 | 5 | |
b4b1e78a | 6 | ;; This file is part of mh-e, part of GNU Emacs. |
c26cf6c8 | 7 | |
9b7bc076 | 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
c26cf6c8 RS |
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) | |
11 | ;; any later version. | |
12 | ||
9b7bc076 | 13 | ;; GNU Emacs is distributed in the hope that it will be useful, |
c26cf6c8 RS |
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. | |
17 | ||
18 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
19 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
20 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 | ;; Boston, MA 02111-1307, USA. | |
c26cf6c8 RS |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; Internal support for mh-e package. | |
26 | ||
847b8219 KH |
27 | ;;; Change Log: |
28 | ||
e84d5560 | 29 | ;; $Id: mh-seq.el,v 1.5 1996/01/14 07:34:30 erik Exp kwzh $ |
847b8219 | 30 | |
c26cf6c8 RS |
31 | ;;; Code: |
32 | ||
33 | (provide 'mh-seq) | |
34 | (require 'mh-e) | |
35 | ||
847b8219 KH |
36 | ;;; Internal variables: |
37 | ||
38 | (defvar mh-last-seq-used nil) ;Name of seq to which a msg was last added. | |
39 | ||
40 | (defvar mh-non-seq-mode-line-annotation nil) ;Saved value of mh-mode-line-annotation when narrowed to a seq. | |
c26cf6c8 RS |
41 | |
42 | ||
847b8219 | 43 | (defun mh-delete-seq (sequence) |
c26cf6c8 RS |
44 | "Delete the SEQUENCE." |
45 | (interactive (list (mh-read-seq-default "Delete" t))) | |
847b8219 KH |
46 | (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note) |
47 | sequence) | |
48 | (mh-undefine-sequence sequence '("all")) | |
49 | (mh-delete-seq-locally sequence)) | |
c26cf6c8 RS |
50 | |
51 | ||
52 | (defun mh-list-sequences (folder) | |
53 | "List the sequences defined in FOLDER." | |
54 | (interactive (list (mh-prompt-for-folder "List sequences in" | |
55 | mh-current-folder t))) | |
847b8219 | 56 | (let ((temp-buffer mh-temp-buffer) |
c26cf6c8 RS |
57 | (seq-list mh-seq-list)) |
58 | (with-output-to-temp-buffer temp-buffer | |
59 | (save-excursion | |
60 | (set-buffer temp-buffer) | |
61 | (erase-buffer) | |
62 | (message "Listing sequences ...") | |
63 | (insert "Sequences in folder " folder ":\n") | |
64 | (while seq-list | |
65 | (let ((name (mh-seq-name (car seq-list))) | |
66 | (sorted-seq-msgs | |
67 | (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)) | |
68 | (last-col (- (window-width) 4)) | |
69 | name-spec) | |
70 | (insert (setq name-spec (format "%20s:" name))) | |
71 | (while sorted-seq-msgs | |
72 | (if (> (current-column) last-col) | |
73 | (progn | |
74 | (insert "\n") | |
75 | (move-to-column (length name-spec)))) | |
76 | (insert (format " %s" (car sorted-seq-msgs))) | |
77 | (setq sorted-seq-msgs (cdr sorted-seq-msgs))) | |
78 | (insert "\n")) | |
79 | (setq seq-list (cdr seq-list))) | |
80 | (goto-char (point-min)) | |
81 | (message "Listing sequences...done"))))) | |
82 | ||
83 | ||
847b8219 KH |
84 | (defun mh-msg-is-in-seq (message) |
85 | "Display the sequences that contain MESSAGE (default: current message)." | |
c26cf6c8 RS |
86 | (interactive (list (mh-get-msg-num t))) |
87 | (message "Message %d is in sequences: %s" | |
847b8219 | 88 | message |
c26cf6c8 | 89 | (mapconcat 'concat |
847b8219 | 90 | (mh-list-to-string (mh-seq-containing-msg message t)) |
c26cf6c8 RS |
91 | " "))) |
92 | ||
93 | ||
847b8219 KH |
94 | (defun mh-narrow-to-seq (sequence) |
95 | "Restrict display of this folder to just messages in SEQUENCE. | |
96 | Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." | |
c26cf6c8 | 97 | (interactive (list (mh-read-seq "Narrow to" t))) |
847b8219 KH |
98 | (with-mh-folder-updating (t) |
99 | (cond ((mh-seq-to-msgs sequence) | |
100 | (mh-widen) | |
101 | (let ((eob (point-max))) | |
102 | (mh-copy-seq-to-point sequence eob) | |
c26cf6c8 | 103 | (narrow-to-region eob (point-max)) |
847b8219 KH |
104 | (make-variable-buffer-local 'mh-non-seq-mode-line-annotation) |
105 | (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation) | |
106 | (setq mh-mode-line-annotation (symbol-name sequence)) | |
107 | (mh-make-folder-mode-line) | |
c26cf6c8 | 108 | (mh-recenter nil) |
847b8219 KH |
109 | (setq mh-narrowed-to-seq sequence))) |
110 | (t | |
111 | (error "No messages in sequence `%s'" (symbol-name sequence)))))) | |
c26cf6c8 RS |
112 | |
113 | ||
847b8219 | 114 | (defun mh-put-msg-in-seq (msg-or-seq sequence) |
c26cf6c8 RS |
115 | "Add MESSAGE(s) (default: displayed message) to SEQUENCE. |
116 | If optional prefix argument provided, then prompt for the message sequence." | |
117 | (interactive (list (if current-prefix-arg | |
118 | (mh-read-seq-default "Add messages from" t) | |
119 | (mh-get-msg-num t)) | |
120 | (mh-read-seq-default "Add to" nil))) | |
847b8219 KH |
121 | (if (not (mh-internal-seq sequence)) |
122 | (setq mh-last-seq-used sequence)) | |
c26cf6c8 RS |
123 | (mh-add-msgs-to-seq (if (numberp msg-or-seq) |
124 | msg-or-seq | |
125 | (mh-seq-to-msgs msg-or-seq)) | |
847b8219 | 126 | sequence)) |
c26cf6c8 RS |
127 | |
128 | ||
129 | (defun mh-widen () | |
130 | "Remove restrictions from current folder, thereby showing all messages." | |
131 | (interactive) | |
132 | (if mh-narrowed-to-seq | |
133 | (with-mh-folder-updating (t) | |
134 | (delete-region (point-min) (point-max)) | |
135 | (widen) | |
847b8219 | 136 | (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation) |
c26cf6c8 RS |
137 | (mh-make-folder-mode-line))) |
138 | (setq mh-narrowed-to-seq nil)) | |
139 | ||
140 | \f | |
141 | ||
142 | ;;; Commands to manipulate sequences. Sequences are stored in an alist | |
143 | ;;; of the form: | |
144 | ;;; ((seq-name msgs ...) (seq-name msgs ...) ...) | |
145 | ||
146 | ||
147 | (defun mh-read-seq-default (prompt not-empty) | |
148 | ;; Read and return sequence name with default narrowed or previous sequence. | |
847b8219 KH |
149 | (mh-read-seq prompt not-empty |
150 | (or mh-narrowed-to-seq | |
151 | mh-last-seq-used | |
152 | (car (mh-seq-containing-msg (mh-get-msg-num nil) nil))))) | |
c26cf6c8 RS |
153 | |
154 | ||
155 | (defun mh-read-seq (prompt not-empty &optional default) | |
156 | ;; Read and return a sequence name. Prompt with PROMPT, raise an error | |
157 | ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply | |
158 | ;; an optional DEFAULT sequence. | |
159 | ;; A reply of '%' defaults to the first sequence containing the current | |
160 | ;; message. | |
161 | (let* ((input (completing-read (format "%s %s %s" prompt "sequence:" | |
162 | (if default | |
163 | (format "[%s] " default) | |
164 | "")) | |
165 | (mh-seq-names mh-seq-list))) | |
847b8219 KH |
166 | (seq (cond ((equal input "%") |
167 | (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) | |
c26cf6c8 RS |
168 | ((equal input "") default) |
169 | (t (intern input)))) | |
170 | (msgs (mh-seq-to-msgs seq))) | |
171 | (if (and (null msgs) not-empty) | |
e84d5560 | 172 | (error "No messages in sequence `%s'" seq)) |
c26cf6c8 RS |
173 | seq)) |
174 | ||
175 | ||
c26cf6c8 RS |
176 | (defun mh-seq-names (seq-list) |
177 | ;; Return an alist containing the names of the SEQUENCES. | |
178 | (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry))))) | |
179 | seq-list)) | |
180 | ||
181 | ||
847b8219 KH |
182 | (defun mh-rename-seq (sequence new-name) |
183 | "Rename SEQUENCE to have NEW-NAME." | |
c26cf6c8 RS |
184 | (interactive (list (mh-read-seq "Old" t) |
185 | (intern (read-string "New sequence name: ")))) | |
847b8219 | 186 | (let ((old-seq (mh-find-seq sequence))) |
c26cf6c8 | 187 | (or old-seq |
847b8219 KH |
188 | (error "Sequence %s does not exist" sequence)) |
189 | ;; create new sequence first, since it might raise an error. | |
c26cf6c8 | 190 | (mh-define-sequence new-name (mh-seq-msgs old-seq)) |
847b8219 | 191 | (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) |
c26cf6c8 RS |
192 | (rplaca old-seq new-name))) |
193 | ||
194 | ||
195 | (defun mh-map-to-seq-msgs (func seq &rest args) | |
196 | ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the | |
197 | ;; remaining ARGS as arguments. | |
198 | (save-excursion | |
199 | (let ((msgs (mh-seq-to-msgs seq))) | |
200 | (while msgs | |
201 | (if (mh-goto-msg (car msgs) t t) | |
202 | (apply func (car msgs) args)) | |
203 | (setq msgs (cdr msgs)))))) | |
204 | ||
205 | ||
206 | (defun mh-notate-seq (seq notation offset) | |
207 | ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER | |
208 | ;; at the given OFFSET from the beginning of the listing line. | |
209 | (mh-map-to-seq-msgs 'mh-notate seq notation offset)) | |
210 | ||
211 | ||
212 | (defun mh-add-to-sequence (seq msgs) | |
213 | ;; Add to a SEQUENCE each message the list of MSGS. | |
214 | (if (not (mh-folder-name-p seq)) | |
215 | (if msgs | |
216 | (apply 'mh-exec-cmd "mark" mh-current-folder "-add" | |
217 | "-sequence" (symbol-name seq) | |
847b8219 | 218 | (mh-coalesce-msg-list msgs))))) |
c26cf6c8 RS |
219 | |
220 | ||
221 | (defun mh-copy-seq-to-point (seq location) | |
222 | ;; Copy the scan listing of the messages in SEQUENCE to after the point | |
223 | ;; LOCATION in the current buffer. | |
224 | (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location)) | |
225 | ||
226 | ||
227 | (defun mh-copy-line-to-point (msg location) | |
228 | ;; Copy the current line to the LOCATION in the current buffer. | |
229 | (beginning-of-line) | |
847b8219 KH |
230 | (save-excursion |
231 | (let ((beginning-of-line (point)) | |
232 | end) | |
233 | (forward-line 1) | |
234 | (setq end (point)) | |
235 | (goto-char location) | |
236 | (insert-buffer-substring (current-buffer) beginning-of-line end)))) | |
c26cf6c8 | 237 |