Mercurial > emacs
annotate lisp/mail/mh-seq.el @ 18817:4a53a2477850
Arrange for the leim tar file to unpack in emacs-M.N/leim.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 16 Jul 1997 04:55:54 +0000 |
parents | 8109feeaf627 |
children | 67b464da13ec |
rev | line source |
---|---|
6365 | 1 ;;; mh-seq --- mh-e sequences support |
13387 | 2 ;; Time-stamp: <95/08/19 16:45:15 gildea> |
6365 | 3 |
11332 | 4 ;; Copyright (C) 1993, 1995 Free Software Foundation, Inc. |
6365 | 5 |
13387 | 6 ;; This file is part of mh-e, part of GNU Emacs. |
6365 | 7 |
11333 | 8 ;; GNU Emacs is free software; you can redistribute it and/or modify |
6365 | 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 | |
11333 | 13 ;; GNU Emacs is distributed in the hope that it will be useful, |
6365 | 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 | |
14169 | 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. | |
6365 | 22 |
23 ;;; Commentary: | |
24 | |
25 ;; Internal support for mh-e package. | |
26 | |
11332 | 27 ;;; Change Log: |
28 | |
14425
8109feeaf627
(mh-read-seq): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
29 ;; $Id: mh-seq.el,v 1.5 1996/01/14 07:34:30 erik Exp kwzh $ |
11332 | 30 |
6365 | 31 ;;; Code: |
32 | |
33 (provide 'mh-seq) | |
34 (require 'mh-e) | |
35 | |
11332 | 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. | |
6365 | 41 |
42 | |
11332 | 43 (defun mh-delete-seq (sequence) |
6365 | 44 "Delete the SEQUENCE." |
45 (interactive (list (mh-read-seq-default "Delete" t))) | |
11332 | 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)) | |
6365 | 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))) | |
11332 | 56 (let ((temp-buffer mh-temp-buffer) |
6365 | 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 | |
11332 | 84 (defun mh-msg-is-in-seq (message) |
85 "Display the sequences that contain MESSAGE (default: current message)." | |
6365 | 86 (interactive (list (mh-get-msg-num t))) |
87 (message "Message %d is in sequences: %s" | |
11332 | 88 message |
6365 | 89 (mapconcat 'concat |
11332 | 90 (mh-list-to-string (mh-seq-containing-msg message t)) |
6365 | 91 " "))) |
92 | |
93 | |
11332 | 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." | |
6365 | 97 (interactive (list (mh-read-seq "Narrow to" t))) |
11332 | 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) | |
6365 | 103 (narrow-to-region eob (point-max)) |
11332 | 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) | |
6365 | 108 (mh-recenter nil) |
11332 | 109 (setq mh-narrowed-to-seq sequence))) |
110 (t | |
111 (error "No messages in sequence `%s'" (symbol-name sequence)))))) | |
6365 | 112 |
113 | |
11332 | 114 (defun mh-put-msg-in-seq (msg-or-seq sequence) |
6365 | 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))) | |
11332 | 121 (if (not (mh-internal-seq sequence)) |
122 (setq mh-last-seq-used sequence)) | |
6365 | 123 (mh-add-msgs-to-seq (if (numberp msg-or-seq) |
124 msg-or-seq | |
125 (mh-seq-to-msgs msg-or-seq)) | |
11332 | 126 sequence)) |
6365 | 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) | |
11332 | 136 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation) |
6365 | 137 (mh-make-folder-mode-line))) |
138 (setq mh-narrowed-to-seq nil)) | |
139 | |
140 | |
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. | |
11332 | 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))))) | |
6365 | 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))) | |
11332 | 166 (seq (cond ((equal input "%") |
167 (car (mh-seq-containing-msg (mh-get-msg-num t) nil))) | |
6365 | 168 ((equal input "") default) |
169 (t (intern input)))) | |
170 (msgs (mh-seq-to-msgs seq))) | |
171 (if (and (null msgs) not-empty) | |
14425
8109feeaf627
(mh-read-seq): Fix error format string.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
172 (error "No messages in sequence `%s'" seq)) |
6365 | 173 seq)) |
174 | |
175 | |
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 | |
11332 | 182 (defun mh-rename-seq (sequence new-name) |
183 "Rename SEQUENCE to have NEW-NAME." | |
6365 | 184 (interactive (list (mh-read-seq "Old" t) |
185 (intern (read-string "New sequence name: ")))) | |
11332 | 186 (let ((old-seq (mh-find-seq sequence))) |
6365 | 187 (or old-seq |
11332 | 188 (error "Sequence %s does not exist" sequence)) |
189 ;; create new sequence first, since it might raise an error. | |
6365 | 190 (mh-define-sequence new-name (mh-seq-msgs old-seq)) |
11332 | 191 (mh-undefine-sequence sequence (mh-seq-msgs old-seq)) |
6365 | 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) | |
11332 | 218 (mh-coalesce-msg-list msgs))))) |
6365 | 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) | |
11332 | 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)))) | |
6365 | 237 |