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