Merge from emacs--rel--22
[bpt/emacs.git] / lisp / mail / pmailsum.el
CommitLineData
e131541f
PR
1;;; pmailsum.el --- make summary buffers for the mail reader
2
3;; Copyright (C) 1985, 1993, 1994, 1995, 1996, 2000, 2001, 2002, 2003,
4;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5
6;; Maintainer: FSF
7;; Keywords: mail
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; All commands run from the summary buffer update the buffer local
27;; variable `pmail-current-message'. As part of the post command
28;; processing point is moved to the beginning of the line describing
29;; the current message.
30
31;;; History:
32
33;; Extended by Bob Weiner of Motorola
34;; Provided all commands from pmail-mode in pmail-summary-mode and made key
35;; bindings in both modes wholly compatible.
36
37;; Overhauled by Paul Reilly to support mbox format.
38
39;;; Code:
40
41(defvar msgnum)
42
43;; For pmail-select-summary
44(require 'pmail)
45
46;;;###autoload
47(defcustom pmail-summary-scroll-between-messages t
48 "*Non-nil means Pmail summary scroll commands move between messages."
49 :type 'boolean
50 :group 'pmail-summary)
51
52;;;###autoload
53(defcustom pmail-summary-line-count-flag t
54 "*Non-nil if Pmail summary should show the number of lines in each message."
55 :type 'boolean
56 :group 'pmail-summary)
57
58(defvar pmail-summary-font-lock-keywords
59 '(("^.....D.*" . font-lock-string-face) ; Deleted.
60 ("^.....-.*" . font-lock-type-face) ; Unread.
61 ;; Neither of the below will be highlighted if either of the above are:
62 ("^.....[^D-]....\\(......\\)" 1 font-lock-keyword-face) ; Date.
63 ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels.
64 "Additional expressions to highlight in Pmail Summary mode.")
65
66(defvar pmail-summary-redo nil
67 "Private storage for Pmail summary history.")
68
69(defvar pmail-summary-overlay nil
70 "Private storage for an Pmail summary overlay cache")
71(put 'pmail-summary-overlay 'permanent-local t)
72
73(defvar pmail-summary-mode-map
74 (let ((map (make-keymap)))
75 (suppress-keymap map)
76 (define-key map [mouse-2] 'pmail-summary-mouse-goto-message)
77 (define-key map "a" 'pmail-summary-add-label)
78 (define-key map "b" 'pmail-summary-bury)
79 (define-key map "B" 'pmail-summary-browse-body)
80 (define-key map "c" 'pmail-summary-continue)
81 (define-key map "d" 'pmail-summary-delete-forward)
82 (define-key map "\C-d" 'pmail-summary-delete-backward)
83 (define-key map "e" 'pmail-summary-edit-current-message)
84 (define-key map "f" 'pmail-summary-forward)
85 (define-key map "g" 'pmail-summary-get-new-mail)
86 (define-key map "h" 'pmail-summary)
87 (define-key map "i" 'pmail-summary-input)
88 (define-key map "j" 'pmail-summary-goto-msg)
89 (define-key map "\C-m" 'pmail-summary-goto-msg)
90 (define-key map "k" 'pmail-summary-kill-label)
91 (define-key map "l" 'pmail-summary-by-labels)
92 (define-key map "\e\C-h" 'pmail-summary)
93 (define-key map "\e\C-l" 'pmail-summary-by-labels)
94 (define-key map "\e\C-r" 'pmail-summary-by-recipients)
95 (define-key map "\e\C-f" 'pmail-summary-by-senders)
96 (define-key map "\e\C-s" 'pmail-summary-by-regexp)
97 (define-key map "\e\C-t" 'pmail-summary-by-topic)
98 (define-key map "m" 'pmail-summary-mail)
99 (define-key map "\M-m" 'pmail-summary-retry-failure)
100 (define-key map "n" 'pmail-summary-next-msg)
101 (define-key map "\en" 'pmail-summary-next-all)
102 (define-key map "\e\C-n" 'pmail-summary-next-labeled-message)
103 (define-key map "o" 'pmail-summary-output)
104 (define-key map "\C-o" 'pmail-summary-output)
105 (define-key map "p" 'pmail-summary-previous-msg)
106 (define-key map "\ep" 'pmail-summary-previous-all)
107 (define-key map "\e\C-p" 'pmail-summary-previous-labeled-message)
108 (define-key map "q" 'pmail-summary-quit)
109 (define-key map "Q" 'pmail-summary-wipe)
110 (define-key map "r" 'pmail-summary-reply)
111 (define-key map "s" 'pmail-summary-expunge-and-save)
112 (define-key map "\es" 'pmail-summary-search)
113 (define-key map "t" 'pmail-summary-toggle-header)
114 (define-key map "u" 'pmail-summary-undelete)
115 (define-key map "\M-u" 'pmail-summary-undelete-many)
116 (define-key map "x" 'pmail-summary-expunge)
117 (define-key map "w" 'pmail-summary-output-body)
118 (define-key map "." 'pmail-summary-beginning-of-message)
119 (define-key map "/" 'pmail-summary-end-of-message)
120 (define-key map "<" 'pmail-summary-first-message)
121 (define-key map ">" 'pmail-summary-last-message)
122 (define-key map " " 'pmail-summary-scroll-msg-up)
123 (define-key map "\177" 'pmail-summary-scroll-msg-down)
124 (define-key map "?" 'describe-mode)
125 (define-key map "\C-c\C-n" 'pmail-summary-next-same-subject)
126 (define-key map "\C-c\C-p" 'pmail-summary-previous-same-subject)
127 (define-key map "\C-c\C-s\C-d" 'pmail-summary-sort-by-date)
128 (define-key map "\C-c\C-s\C-s" 'pmail-summary-sort-by-subject)
129 (define-key map "\C-c\C-s\C-a" 'pmail-summary-sort-by-author)
130 (define-key map "\C-c\C-s\C-r" 'pmail-summary-sort-by-recipient)
131 (define-key map "\C-c\C-s\C-c" 'pmail-summary-sort-by-correspondent)
132 (define-key map "\C-c\C-s\C-l" 'pmail-summary-sort-by-lines)
133 (define-key map "\C-c\C-s\C-k" 'pmail-summary-sort-by-labels)
134 (define-key map [menu-bar] (make-sparse-keymap))
135 (define-key map [menu-bar classify]
136 (cons "Classify" (make-sparse-keymap "Classify")))
137 (define-key map [menu-bar classify output-menu]
138 '("Output (Pmail Menu)..." . pmail-summary-output-menu))
139 (define-key map [menu-bar classify input-menu]
140 '("Input Pmail File (menu)..." . pmail-input-menu))
141 (define-key map [menu-bar classify input-menu] '(nil))
142 (define-key map [menu-bar classify output-menu] '(nil))
143 (define-key map [menu-bar classify output-body]
144 '("Output (body)..." . pmail-summary-output-body))
145 (define-key map [menu-bar classify output-inbox]
146 '("Output (inbox)..." . pmail-summary-output))
147 (define-key map [menu-bar classify output]
148 '("Output (Pmail)..." . pmail-summary-output))
149 (define-key map [menu-bar classify kill-label]
150 '("Kill Label..." . pmail-summary-kill-label))
151 (define-key map [menu-bar classify add-label]
152 '("Add Label..." . pmail-summary-add-label))
153 (define-key map [menu-bar summary]
154 (cons "Summary" (make-sparse-keymap "Summary")))
155 (define-key map [menu-bar summary senders]
156 '("By Senders..." . pmail-summary-by-senders))
157 (define-key map [menu-bar summary labels]
158 '("By Labels..." . pmail-summary-by-labels))
159 (define-key map [menu-bar summary recipients]
160 '("By Recipients..." . pmail-summary-by-recipients))
161 (define-key map [menu-bar summary topic]
162 '("By Topic..." . pmail-summary-by-topic))
163 (define-key map [menu-bar summary regexp]
164 '("By Regexp..." . pmail-summary-by-regexp))
165 (define-key map [menu-bar summary all]
166 '("All" . pmail-summary))
167 (define-key map [menu-bar mail]
168 (cons "Mail" (make-sparse-keymap "Mail")))
169 (define-key map [menu-bar mail pmail-summary-get-new-mail]
170 '("Get New Mail" . pmail-summary-get-new-mail))
171 (define-key map [menu-bar mail lambda]
172 '("----"))
173 (define-key map [menu-bar mail continue]
174 '("Continue" . pmail-summary-continue))
175 (define-key map [menu-bar mail resend]
176 '("Re-send..." . pmail-summary-resend))
177 (define-key map [menu-bar mail forward]
178 '("Forward" . pmail-summary-forward))
179 (define-key map [menu-bar mail retry]
180 '("Retry" . pmail-summary-retry-failure))
181 (define-key map [menu-bar mail reply]
182 '("Reply" . pmail-summary-reply))
183 (define-key map [menu-bar mail mail]
184 '("Mail" . pmail-summary-mail))
185 (define-key map [menu-bar delete]
186 (cons "Delete" (make-sparse-keymap "Delete")))
187 (define-key map [menu-bar delete expunge/save]
188 '("Expunge/Save" . pmail-summary-expunge-and-save))
189 (define-key map [menu-bar delete expunge]
190 '("Expunge" . pmail-summary-expunge))
191 (define-key map [menu-bar delete undelete]
192 '("Undelete" . pmail-summary-undelete))
193 (define-key map [menu-bar delete delete]
194 '("Delete" . pmail-summary-delete-forward))
195 (define-key map [menu-bar move]
196 (cons "Move" (make-sparse-keymap "Move")))
197 (define-key map [menu-bar move search-back]
198 '("Search Back..." . pmail-summary-search-backward))
199 (define-key map [menu-bar move search]
200 '("Search..." . pmail-summary-search))
201 (define-key map [menu-bar move previous]
202 '("Previous Nondeleted" . pmail-summary-previous-msg))
203 (define-key map [menu-bar move next]
204 '("Next Nondeleted" . pmail-summary-next-msg))
205 (define-key map [menu-bar move last]
206 '("Last" . pmail-summary-last-message))
207 (define-key map [menu-bar move first]
208 '("First" . pmail-summary-first-message))
209 (define-key map [menu-bar move previous]
210 '("Previous" . pmail-summary-previous-all))
211 (define-key map [menu-bar move next]
212 '("Next" . pmail-summary-next-all))
213 map)
214 "Keymap for `pmail-summary-mode'.")
215
acdc2006
PR
216(declare-function pmail-abort-edit "pmailedit" ())
217(declare-function pmail-cease-edit "pmailedit"())
218(declare-function pmail-set-label "pmailkwd" (l state &optional n))
219(declare-function pmail-output-read-file-name "pmailout" ())
220(declare-function pmail-output-read-pmail-file-name "pmailout" ())
221(declare-function mail-comma-list-regexp "mail-utils" (labels))
222(declare-function mail-send-and-exit "sendmail" (&optional arg))
223(declare-function mail-strip-quoted-names "mail-utils" (address))
224
e131541f
PR
225;; Entry points for making a summary buffer.
226
227;; Regenerate the contents of the summary
228;; using the same selection criterion as last time.
229;; M-x revert-buffer in a summary buffer calls this function.
230(defun pmail-update-summary (&rest ignore)
231 (apply (car pmail-summary-redo) (cdr pmail-summary-redo)))
232
233;;;###autoload
234(defun pmail-summary ()
235 "Display a summary of all messages, one line per message."
236 (interactive)
237 (pmail-new-summary "All" '(pmail-summary) nil))
238
239;;;###autoload
240(defun pmail-summary-by-labels (labels)
241 "Display a summary of all messages with one or more LABELS.
242LABELS should be a string containing the desired labels, separated by commas."
243 (interactive "sLabels to summarize by: ")
244 (if (string= labels "")
245 (setq labels (or pmail-last-multi-labels
246 (error "No label specified"))))
247 (setq pmail-last-multi-labels labels)
248 (pmail-new-summary (concat "labels " labels)
249 (list 'pmail-summary-by-labels labels)
250 'pmail-message-labels-p
251 (mail-comma-list-regexp labels)))
252
253;;;###autoload
254(defun pmail-summary-by-recipients (recipients &optional primary-only)
255 "Display a summary of all messages with the given RECIPIENTS.
256Normally checks the To, From and Cc fields of headers;
257but if PRIMARY-ONLY is non-nil (prefix arg given),
258 only look in the To and From fields.
259RECIPIENTS is a string of regexps separated by commas."
260 (interactive "sRecipients to summarize by: \nP")
261 (pmail-new-summary
262 (concat "recipients " recipients)
263 (list 'pmail-summary-by-recipients recipients primary-only)
264 'pmail-message-recipients-p
265 (mail-comma-list-regexp recipients) primary-only))
266
267;;;###autoload
268(defun pmail-summary-by-regexp (regexp)
269 "Display a summary of all messages according to regexp REGEXP.
270If the regular expression is found in the header of the message
271\(including in the date and other lines, as well as the subject line),
272Emacs will list the header line in the PMAIL-summary."
273 (interactive "sRegexp to summarize by: ")
274 (if (string= regexp "")
275 (setq regexp (or pmail-last-regexp
276 (error "No regexp specified"))))
277 (setq pmail-last-regexp regexp)
278 (pmail-new-summary (concat "regexp " regexp)
279 (list 'pmail-summary-by-regexp regexp)
280 'pmail-message-regexp-p
281 regexp))
282
283;;;###autoload
284(defun pmail-summary-by-topic (subject &optional whole-message)
285 "Display a summary of all messages with the given SUBJECT.
286Normally checks the Subject field of headers;
287but if WHOLE-MESSAGE is non-nil (prefix arg given),
288 look in the whole message.
289SUBJECT is a string of regexps separated by commas."
290 (interactive
291 (let* ((subject (with-current-buffer pmail-buffer
292 (pmail-current-subject)))
293 (prompt (concat "Topics to summarize by (regexp"
294 (if subject ", default current subject" "")
295 "): ")))
296 (list (read-string prompt nil nil subject) current-prefix-arg)))
297 (pmail-new-summary
298 (concat "about " subject)
299 (list 'pmail-summary-by-topic subject whole-message)
300 'pmail-message-subject-p
301 (mail-comma-list-regexp subject) whole-message))
302
303(defun pmail-message-subject-p (msg subject &optional whole-message)
304 "Return non-nil if SUBJECT is found in MSG.
305If WHOLE-MESSAGE is nil only the subject header will be searched,
306otherwise the whole message will be searched for text matching
307SUBJECT. Return nil to indicate that SUBJECT is not found,
308non-nil otherwise."
309 (save-restriction
310 (narrow-to-region
311 (pmail-desc-get-start msg)
312 (pmail-desc-get-end msg))
313 (goto-char (point-min))
314 (if whole-message
315 (re-search-forward subject nil t))
316 (string-match subject
317 (let ((subj (pmail-header-get-header "subject")))
318 (if subj
319 (funcall pmail-summary-line-decoder subj)
320 "")))))
321
322;;;###autoload
323(defun pmail-summary-by-senders (senders)
324 "Display a summary of all messages with the given SENDERS.
325SENDERS is a string of names separated by commas."
326 (interactive
327 (let* ((sender (when pmail-current-message
328 (pmail-desc-get-sender pmail-current-message)))
329 (sender-re (with-current-buffer pmail-buffer
330 (regexp-quote sender)))
331 (prompt (concat "Senders to summarize by (regexp"
332 (if sender ", default current sender" "")
333 "): ")))
334 (list (read-string prompt nil nil sender))))
335 (pmail-new-summary
336 (concat "senders " senders)
337 (list 'pmail-summary-by-senders senders)
338 'pmail-message-senders-p
339 (mail-comma-list-regexp senders)))
340
341(defun pmail-message-senders-p (msg sender)
342 "Return non-nil if SENDER is found in MSG.
343The From header is tested."
344 (save-restriction
345 (narrow-to-region
346 (pmail-desc-get-start msg)
347 (pmail-desc-get-end msg))
348 (goto-char (point-min))
349 (string-match sender (or (mail-fetch-field "From") ""))))
350\f
351;;;; General making of a summary buffer.
352
353(defvar pmail-summary-symbol-number 0)
354
355(defun pmail-new-summary (description redo-form function &rest args)
356 "Create a summary of selected messages.
357DESCRIPTION makes part of the mode line of the summary buffer.
358For each message, FUNCTION is applied to the message number and ARGS...
359and if the result is non-nil, that message is included.
360nil for FUNCTION means all messages."
361 (message "Computing summary lines...")
362 (let ((summary-msgs ())
363 (new-summary-line-count 0)
364 (msgnum 1)
365 current-message sumbuf was-in-summary)
366 (save-excursion
367 ;; Go to the Pmail buffer.
368 (if (eq major-mode 'pmail-summary-mode)
369 (setq was-in-summary t))
370 (set-buffer pmail-buffer)
371 ;; Find its summary buffer, or make one.
372 (setq current-message pmail-current-message
373 sumbuf
374 (if (and pmail-summary-buffer
375 (buffer-name pmail-summary-buffer))
376 pmail-summary-buffer
377 (generate-new-buffer (concat (buffer-name) "-summary"))))
378 ;; Collect the message summaries based on the filtering
379 ;; argument (FUNCTION).
380 (while (>= pmail-total-messages msgnum)
381 (if (or (null function)
382 (apply function (cons msgnum args)))
383 (setq summary-msgs
384 (cons (cons msgnum (pmail-summary-get-summary-line msgnum))
385 summary-msgs)))
386 (setq msgnum (1+ msgnum)))
387 (setq summary-msgs (nreverse summary-msgs))
388 ;; Place the collected summaries into the summary buffer.
389 (setq pmail-summary-buffer nil)
390 (save-excursion
391 (let ((rbuf (current-buffer))
392 (vbuf pmail-view-buffer)
393 (total pmail-total-messages))
394 (set-buffer sumbuf)
395 ;; Set up the summary buffer's contents.
396 (let ((buffer-read-only nil))
397 (erase-buffer)
398 (while summary-msgs
399 (princ (cdr (car summary-msgs)) sumbuf)
400 (setq summary-msgs (cdr summary-msgs)))
401 (goto-char (point-min)))
402 ;; Set up the rest of its state and local variables.
403 (setq buffer-read-only t)
404 (pmail-summary-mode)
405 (make-local-variable 'minor-mode-alist)
406 (setq minor-mode-alist (list (list t (concat ": " description))))
407 (setq pmail-buffer rbuf
408 pmail-view-buffer vbuf
409 pmail-summary-redo redo-form
410 pmail-total-messages total
411 pmail-current-message current-message)))
412 (setq pmail-summary-buffer sumbuf))
413 ;; Now display the summary buffer and go to the right place in it.
414 (or was-in-summary
415 (progn
416 (if (and (one-window-p)
417 pop-up-windows (not pop-up-frames))
418 ;; If there is just one window, put the summary on the top.
419 (progn
420 (split-window (selected-window) pmail-summary-window-size)
421 (select-window (next-window (frame-first-window)))
422 (pop-to-buffer sumbuf)
423 ;; If pop-to-buffer did not use that window, delete that
424 ;; window. (This can happen if it uses another frame.)
425 (if (not (eq sumbuf (window-buffer (frame-first-window))))
426 (delete-other-windows)))
427 (pop-to-buffer sumbuf))
428 (set-buffer pmail-buffer)
429 ;; This is how pmail makes the summary buffer reappear.
430 ;; We do this here to make the window the proper size.
431 (pmail-select-summary nil)
432 (set-buffer pmail-summary-buffer)))
433 (pmail-summary-goto-msg current-message nil t)
434 (pmail-summary-construct-io-menu)
435 (message "Computing summary lines...done")))
436\f
437;;;; Low levels of generating a summary.
438
439;;;###autoload
440(defcustom pmail-summary-line-decoder (function identity)
441 "*Function to decode summary-line.
442
443By default, `identity' is set."
444 :type 'function
445 :group 'pmail-summary)
446
447;;;###autoload
448(defcustom pmail-user-mail-address-regexp
449 (concat "^\\("
450 (regexp-quote (user-login-name))
451 "\\($\\|@\\)\\|"
452 (regexp-quote
453 (or user-mail-address
454 (concat (user-login-name) "@"
455 (or mail-host-address
456 (system-name)))))
457 "\\>\\)")
458 "*Regexp matching user mail addresses.
459If non-nil, this variable is used to identify the correspondent
460when receiving new mail. If it matches the address of the
461sender, the recipient is taken as correspondent of a mail. It is
462initialized based on your `user-login-name' and
463`user-mail-address'.
464
465Usually you don't have to set this variable, except if you
466collect mails sent by you under different user names. Then it
467should be a regexp matching your mail addresses.
468
469Setting this variable has an effect only before reading a mail."
470 :type '(choice (const :tag "None" nil) regexp)
471 :group 'pmail-retrieve
472 :version "21.1")
473
474\f
475;;;; Simple motion in a summary buffer.
476
477(defun pmail-summary-next-all (&optional number)
478 "Move to an nearby message.
479If NUMBER is positive then move forward NUMBER messages. If NUMBER is
480negative then move backwards NUMBER messages. If NUMBER is nil then
481move forward one message."
482 (interactive "p")
483 (forward-line (if number number 1))
484 ;; It doesn't look nice to move forward past the last message line.
485 (and (eobp) (> number 0)
486 (forward-line -1))
487 (display-buffer pmail-buffer))
488
489(defun pmail-summary-previous-all (&optional number)
490 (interactive "p")
491 (forward-line (- (if number number 1)))
492 ;; It doesn't look nice to move forward past the last message line.
493 (and (eobp) (< number 0)
494 (forward-line -1))
495 (display-buffer pmail-buffer))
496
497(defun pmail-summary-next-msg (&optional number)
498 "Display next non-deleted msg from pmail file.
499With optional prefix argument NUMBER, moves forward this number of
500non-deleted messages, or backward if NUMBER is negative."
501 (interactive "p")
502 (let (msg)
503 (with-current-buffer pmail-buffer
504 (pmail-next-undeleted-message number)
505 (setq msg pmail-current-message))
506 (pmail-summary-goto-msg msg)))
507
508(defun pmail-summary-previous-msg (&optional number)
509 "Display previous non-deleted msg from pmail file.
510With optional prefix argument NUMBER, moves backward this number of
511non-deleted messages."
512 (interactive "p")
513 (pmail-summary-next-msg (- (if number number 1))))
514
515(defun pmail-summary-next-labeled-message (n labels)
516 "Show next message with LABEL. Defaults to last labels used.
517With prefix argument N moves forward N messages with these labels."
518 (interactive "p\nsMove to next msg with labels: ")
519 (let (msg)
520 (save-excursion
521 (set-buffer pmail-buffer)
522 (pmail-next-labeled-message n labels)
523 (setq msg pmail-current-message))
524 (setq pmail-current-message msg)))
525
526(defun pmail-summary-previous-labeled-message (n labels)
527 "Show previous message with LABEL. Defaults to last labels used.
528With prefix argument N moves backward N messages with these labels."
529 (interactive "p\nsMove to previous msg with labels: ")
530 (let (msg)
531 (save-excursion
532 (set-buffer pmail-buffer)
533 (pmail-previous-labeled-message n labels)
534 (setq msg pmail-current-message))
535 (setq pmail-current-message msg)))
536
537(defun pmail-summary-next-same-subject (n)
538 "Go to the next message in the summary having the same subject.
539With prefix argument N, do this N times.
540If N is negative, go backwards."
541 (interactive "p")
542 (with-current-buffer pmail-buffer
543 (pmail-next-same-subject n)))
544
545(defun pmail-summary-previous-same-subject (n)
546 "Go to the previous message in the summary having the same subject.
547With prefix argument N, do this N times.
548If N is negative, go forwards instead."
549 (interactive "p")
550 (pmail-summary-next-same-subject (- n)))
551
552\f
553;; Delete and undelete summary commands.
554
555(defun pmail-summary-delete-forward (&optional count)
556 "Delete this message and move to next nondeleted one.
557Deleted messages stay in the file until the \\[pmail-expunge] command is given.
558A prefix argument serves as a repeat count;
559a negative argument means to delete and move backward."
560 (interactive "p")
561 (unless (numberp count) (setq count 1))
562 (let (end del-msg
563 (backward (< count 0)))
564 (while (/= count 0)
565 (pmail-summary-goto-msg)
566 (with-current-buffer pmail-buffer
567 (pmail-delete-message)
568 (setq del-msg pmail-current-message))
569 (pmail-summary-mark-deleted del-msg)
570 (while (and (not (if backward (bobp) (eobp)))
571 (save-excursion (beginning-of-line)
572 (looking-at " *[0-9]+D")))
573 (forward-line (if backward -1 1)))
574 (setq count
575 (if (> count 0) (1- count) (1+ count))))
576 ;; Update the summary buffer current message counter and show the
577 ;; message in the Pmail buffer.
578 (pmail-summary-goto-msg (pmail-summary-get-message-at-point))))
579
580(defun pmail-summary-delete-backward (&optional count)
581 "Delete this message and move to previous nondeleted one.
582Deleted messages stay in the file until the \\[pmail-expunge] command is given.
583A prefix argument serves as a repeat count;
584a negative argument means to delete and move forward."
585 (interactive "p")
586 (pmail-summary-delete-forward (- count)))
587
588(defun pmail-summary-mark-deleted (&optional n undel)
589 ;; Since third arg is t, this only alters the summary, not the Pmail buf.
590 (and n (pmail-summary-goto-msg n t))
591 (or (eobp)
592 (not (overlay-get pmail-summary-overlay 'face))
593 (let ((buffer-read-only nil))
594 (skip-chars-forward " ")
595 (skip-chars-forward "[0-9]")
596 (if undel
597 (if (looking-at "D")
598 (progn (delete-char 1) (insert " ")))
599 (delete-char 1)
600 (insert "D"))))
601 (beginning-of-line))
602
603(defun pmail-summary-mark-undeleted (n)
604 (pmail-summary-mark-deleted n t))
605
606(defun pmail-summary-deleted-p (&optional n)
607 (unless n (setq n pmail-current-message))
608 (with-current-buffer pmail-buffer
609 (pmail-desc-deleted-p n)))
610
611(defun pmail-summary-undelete (&optional arg)
612 "Undelete current message.
613Optional prefix ARG means undelete ARG previous messages."
614 (interactive "p")
615 (if (/= arg 1)
616 (pmail-summary-undelete-many arg)
617 (let ((buffer-read-only nil)
618 (opoint (point)))
619 (goto-char (line-end-position))
620 (if (not (re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t))
621 (goto-char opoint)
622 (replace-match "\\1 ")
623 (pmail-summary-goto-msg)
624 (if pmail-enable-mime
625 (set-buffer pmail-buffer)
626 (pop-to-buffer pmail-buffer))
627 (when (pmail-message-deleted-p pmail-current-message)
628 (pmail-undelete-previous-message))
629 (when pmail-enable-mime
630 (pop-to-buffer pmail-view-buffer))
631 (pop-to-buffer pmail-summary-buffer)))))
632
633(defun pmail-summary-undelete-many (&optional n)
634 "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
635 (interactive "P")
636 (with-current-buffer pmail-buffer
637 (let* ((init-msg (if n pmail-current-message pmail-total-messages))
638 (pmail-current-message init-msg)
639 (n (or n pmail-total-messages))
640 (msgs-undeled 0))
641 (while (and (> pmail-current-message 0) (< msgs-undeled n))
642 (when (pmail-message-deleted-p pmail-current-message)
643 (pmail-set-attribute "deleted" nil)
644 (setq msgs-undeled (1+ msgs-undeled)))
645 (setq pmail-current-message (1- pmail-current-message)))
646 (with-current-buffer pmail-summary-buffer
647 (setq pmail-current-message init-msg msgs-undeled 0)
648 (while (and (> pmail-current-message 0) (< msgs-undeled n))
649 (when (pmail-summary-deleted-p pmail-current-message)
650 (pmail-summary-mark-undeleted pmail-current-message)
651 (setq msgs-undeled (1+ msgs-undeled)))
652 (setq pmail-current-message (1- pmail-current-message)))))))
653\f
654;; Pmail Summary mode is suitable only for specially formatted data.
655(put 'pmail-summary-mode 'mode-class 'special)
656
657(defun pmail-summary-mode ()
658 "Pmail Summary Mode is invoked from Pmail Mode by using \\<pmail-mode-map>\\[pmail-summary].
659As commands are issued in the summary buffer, they are applied to the
660corresponding mail messages in the pmail buffer.
661
662All normal editing commands are turned off.
663Instead, nearly all the Pmail mode commands are available,
664though many of them move only among the messages in the summary.
665
666These additional commands exist:
667
668\\[pmail-summary-undelete-many] Undelete all or prefix arg deleted messages.
669\\[pmail-summary-wipe] Delete the summary and go to the Pmail buffer.
670
671Commands for filtering the summary:
672
673\\[pmail-summary-by-labels] Filter by label.
674\\[pmail-summary-by-topic] Filter by Subject.
675 Filter by the entire message (header and body) if given a
676 prefix argument.
677\\[pmail-summary-by-senders] Filter by From field.
678\\[pmail-summary-by-recipients] Filter by To, From, and Cc fields.
679 Filter by To and From only if given a prefix argument.
680
681The commands listed above take comma-separated lists of regular
682expressions.
683
684\\[pmail-summary-by-regexp] Filter by any header line.
685\\[pmail-summary] Restore the default summary.
686
687Commands for sorting the summary:
688
689\\[pmail-summary-sort-by-date] Sort by date.
690\\[pmail-summary-sort-by-subject] Sort by subject.
691\\[pmail-summary-sort-by-author] Sort by author.
692\\[pmail-summary-sort-by-recipient] Sort by recipient.
693\\[pmail-summary-sort-by-correspondent] Sort by correspondent.
694\\[pmail-summary-sort-by-lines] Sort by lines.
695\\[pmail-summary-sort-by-labels] Sort by labels."
696 (interactive)
697 (kill-all-local-variables)
698 (setq major-mode 'pmail-summary-mode)
699 (setq mode-name "PMAIL Summary")
700 (setq truncate-lines t)
701 (setq buffer-read-only t)
702 (set-syntax-table text-mode-syntax-table)
703 (make-local-variable 'pmail-buffer)
704 (make-local-variable 'pmail-view-buffer)
705 (make-local-variable 'pmail-total-messages)
706 (make-local-variable 'pmail-current-message)
707 (setq pmail-current-message nil)
708 (make-local-variable 'pmail-summary-redo)
709 (setq pmail-summary-redo nil)
710 (make-local-variable 'revert-buffer-function)
711 (make-local-variable 'font-lock-defaults)
712 (setq font-lock-defaults '(pmail-summary-font-lock-keywords t))
713 (pmail-summary-enable)
714 (run-mode-hooks 'pmail-summary-mode-hook))
715
716;; Summary features need to be disabled during edit mode.
717(defun pmail-summary-disable ()
718 (use-local-map text-mode-map)
719 (remove-hook 'post-command-hook 'pmail-summary-pmail-update t)
720 (setq revert-buffer-function nil))
721
722(defun pmail-summary-enable ()
723 (use-local-map pmail-summary-mode-map)
724 (add-hook 'post-command-hook 'pmail-summary-pmail-update nil t)
725 (setq revert-buffer-function 'pmail-update-summary))
726
727(defvar pmail-summary-put-back-unseen nil
728 "Used for communicating between calls to `pmail-summary-pmail-update'.
729If it moves to a message within an Incremental Search, and removes
730the `unseen' attribute from that message, it sets this flag
731so that if the next motion between messages is in the same Incremental
732Search, the `unseen' attribute is restored.")
733
734(defun pmail-summary-pmail-update ()
735 "Update the Pmail summary buffer.
736Put the cursor on the beginning of the line containing the
737current message and highlight the buffer. Show in Pmail the
738message described by the summary line that point is on, but only
739if the Pmail buffer is already visible. This is on
740`post-command-hook' in summary buffers."
741 (let (buffer-read-only)
742 (save-excursion
743 ;; If at end of buffer, pretend we are on the last text line.
744 (when (eobp)
745 (forward-line -1))
746 ;; Determine the message number corresponding to line point is on.
747 (beginning-of-line)
748 (skip-chars-forward " ")
749 (let ((msg-num (string-to-number (buffer-substring
750 (point)
751 (progn (skip-chars-forward "0-9")
752 (point))))))
753 ;; Always leave `unseen' removed if we get out of isearch mode.
754 ;; Don't let a subsequent isearch restore `unseen'.
755 (when (not isearch-mode)
756 (setq pmail-summary-put-back-unseen nil))
757 (or (eq pmail-current-message msg-num)
758 (let ((window (get-buffer-window pmail-view-buffer t))
759 (owin (selected-window)))
760 (if isearch-mode
761 (save-excursion
762 (set-buffer pmail-buffer)
763 ;; If we first saw the previous message in this
764 ;; search, and we have gone to a different message
765 ;; while searching, put back `unseen' on the former
766 ;; one.
767 (if pmail-summary-put-back-unseen
768 (pmail-set-attribute "unseen" t
769 pmail-current-message))
770 ;; Arrange to do that later, for the new current message,
771 ;; if it still has `unseen'.
772 (setq pmail-summary-put-back-unseen
773 (member "unseen" (pmail-desc-get-keywords msg-num))))
774 (setq pmail-summary-put-back-unseen nil))
775 ;; Go to the desired message.
776 (setq pmail-current-message msg-num)
777 ;; Update the summary to show the message has been seen.
778 (when (= (following-char) ?-)
779 (delete-char 1)
780 (insert " "))
781 (if window
782 ;; Using save-window-excursion would cause the new value
783 ;; of point to get lost.
784 (unwind-protect
785 (progn
786 (select-window window)
787 (pmail-show-message msg-num t))
788 (select-window owin))
789 (when (buffer-name pmail-buffer)
790 (save-excursion
791 (set-buffer pmail-buffer)
792 (pmail-show-message msg-num t))))))
793 (pmail-summary-update-highlight nil)))))
794\f
795(defun pmail-summary-mouse-goto-message (event)
796 "Select the message whose summary line you click on."
797 (interactive "@e")
798 (goto-char (posn-point (event-end event)))
799 (setq pmail-current-message (pmail-summary-get-message-at-point))
800 (pmail-summary-pmail-update))
801
802(defun pmail-summary-get-message-at-point ()
803 "Return the message number corresponding to the line containing point.
804If the summary buffer contains no messages, nil is returned."
805 (save-excursion
806 ;; Position point at the beginning of a line.
807 (if (eobp)
808 (forward-line -1)
809 (forward-line 0))
810 ;; Parse the message number.
811 (string-to-number
812 (buffer-substring (point) (min (point-max) (+ 6 (point)))))))
813
814(defun pmail-summary-goto-msg (&optional n nowarn skip-pmail)
815 "Go to message N in the summary buffer and the Pmail buffer.
816If N is nil, use the message corresponding to point in the summary
817buffer and move to that message in the Pmail buffer.
818
819If NOWARN, don't say anything if N is out of range.
820If SKIP-PMAIL, don't do anything to the Pmail buffer."
821 (interactive "P")
822 (if (consp n) (setq n (prefix-numeric-value n)))
823 ;; Do the end of buffer adjustment.
824 (if (eobp) (forward-line -1))
825 (beginning-of-line)
826 ;; Set N to the current message unless it was already set by the
827 ;; caller.
828 (unless n (setq n (pmail-summary-get-message-at-point)))
829 (let* ((obuf (current-buffer))
830 (buf pmail-buffer)
831 (cur (point))
832 message-not-found
833 (curmsg (string-to-number
834 (buffer-substring (point)
835 (min (point-max) (+ 6 (point))))))
836 (total (with-current-buffer buf
837 pmail-total-messages)))
838 ;; Do a validity check on N. If it is valid then set the current
839 ;; summary message to N. `pmail-summary-pmail-update' will then
840 ;; actually move point to the selected message.
841 (if (< n 1)
842 (progn (message "No preceding message")
843 (setq n 1)))
844 (if (and (> n total)
845 (> total 0))
846 (progn (message "No following message")
847 (goto-char (point-max))
848 (pmail-summary-goto-msg nil nowarn skip-pmail)))
849 (goto-char (point-min))
850 (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t))
851 (progn (or nowarn (message "Message %d not found" n))
852 (setq n curmsg)
853 (setq message-not-found t)
854 (goto-char cur)))
855 (beginning-of-line)
856 (skip-chars-forward " ")
857 (skip-chars-forward "0-9")
858 (save-excursion (if (= (following-char) ?-)
859 (let ((buffer-read-only nil))
860 (delete-char 1)
861 (insert " "))))
862 (pmail-summary-update-highlight message-not-found)
863 (beginning-of-line)
864 ;; Determine if the Pmail buffer needs to be processed.
865 (if skip-pmail
866 nil
867 ;; It does.
868 (let ((selwin (selected-window)))
869 (unwind-protect
870 (progn (pop-to-buffer buf)
871 (pmail-show-message n))
872 (select-window selwin)
873 ;; The actions above can alter the current buffer. Preserve it.
874 (set-buffer obuf))))))
875
876;; Update the highlighted line in an pmail summary buffer.
877;; That should be current. We highlight the line point is on.
878;; If NOT-FOUND is non-nil, we turn off highlighting.
879(defun pmail-summary-update-highlight (not-found)
880 ;; Make sure we have an overlay to use.
881 (or pmail-summary-overlay
882 (progn
883 (make-local-variable 'pmail-summary-overlay)
884 (setq pmail-summary-overlay (make-overlay (point) (point)))))
885 ;; If this message is in the summary, use the overlay to highlight it.
886 ;; Otherwise, don't highlight anything.
887 (if not-found
888 (overlay-put pmail-summary-overlay 'face nil)
889 (move-overlay pmail-summary-overlay
890 (save-excursion (beginning-of-line)
891 (skip-chars-forward " ")
892 (point))
893 (save-excursion (end-of-line) (point)))
894 (overlay-put pmail-summary-overlay 'face 'highlight)))
895\f
896(defun pmail-summary-scroll-msg-up (&optional dist)
897 "Scroll the Pmail window forward.
898If the Pmail window is displaying the end of a message,
899advance to the next message."
900 (interactive "P")
901 (if (eq dist '-)
902 (pmail-summary-scroll-msg-down nil)
903 (let ((pmail-buffer-window (get-buffer-window pmail-view-buffer)))
904 (if pmail-buffer-window
905 (if (let ((pmail-summary-window (selected-window)))
906 (select-window pmail-buffer-window)
907 (prog1
908 ;; Is EOB visible in the buffer?
909 (save-excursion
910 (let ((ht (window-height (selected-window))))
911 (move-to-window-line (- ht 2))
912 (end-of-line)
913 (eobp)))
914 (select-window pmail-summary-window)))
915 (if (not pmail-summary-scroll-between-messages)
916 (error "End of buffer")
917 (pmail-summary-next-msg (or dist 1)))
918 (let ((other-window-scroll-buffer pmail-view-buffer))
919 (scroll-other-window dist)))
920 ;; If it isn't visible at all, show the beginning.
921 (pmail-summary-beginning-of-message)))))
922
923(defun pmail-summary-scroll-msg-down (&optional dist)
924 "Scroll the Pmail window backward.
925If the Pmail window is now displaying the beginning of a message,
926move to the previous message."
927 (interactive "P")
928 (if (eq dist '-)
929 (pmail-summary-scroll-msg-up nil)
930 (let ((pmail-buffer-window (get-buffer-window pmail-view-buffer)))
931 (if pmail-buffer-window
932 (if (let ((pmail-summary-window (selected-window)))
933 (select-window pmail-buffer-window)
934 (prog1
935 ;; Is BOB visible in the buffer?
936 (save-excursion
937 (move-to-window-line 0)
938 (beginning-of-line)
939 (bobp))
940 (select-window pmail-summary-window)))
941 (if (not pmail-summary-scroll-between-messages)
942 (error "Beginning of buffer")
943 (pmail-summary-previous-msg (or dist 1)))
944 (let ((other-window-scroll-buffer pmail-view-buffer))
945 (scroll-other-window-down dist)))
946 ;; If it isn't visible at all, show the beginning.
947 (pmail-summary-beginning-of-message)))))
948
949(defun pmail-summary-beginning-of-message ()
950 "Show current message from the beginning."
951 (interactive)
952 (pmail-summary-show-message 'BEG))
953
954(defun pmail-summary-end-of-message ()
955 "Show bottom of current message."
956 (interactive)
957 (pmail-summary-show-message 'END))
958
959(defun pmail-summary-show-message (where)
960 "Show current mail message.
961Position it according to WHERE which can be BEG or END"
962 (if (and (one-window-p) (not pop-up-frames))
963 ;; If there is just one window, put the summary on the top.
964 (let ((buffer pmail-view-buffer))
965 (split-window (selected-window) pmail-summary-window-size)
966 (select-window (frame-first-window))
967 (pop-to-buffer pmail-view-buffer)
968 ;; If pop-to-buffer did not use that window, delete that
969 ;; window. (This can happen if it uses another frame.)
970 (or (eq buffer (window-buffer (next-window (frame-first-window))))
971 (delete-other-windows)))
972 (pop-to-buffer pmail-view-buffer))
973 (cond ((eq where 'BEG)
974 (goto-char (point-min))
975 (search-forward "\n\n"))
976 ((eq where 'END)
977 (goto-char (point-max))
978 (recenter (1- (window-height)))))
979 (pop-to-buffer pmail-summary-buffer))
980
981(defun pmail-summary-bury ()
982 "Bury the Pmail buffer and the Pmail summary buffer."
983 (interactive)
984 (let ((buffer-to-bury (current-buffer)))
985 (let (window)
986 (while (setq window (get-buffer-window pmail-buffer))
987 (set-window-buffer window (other-buffer pmail-buffer)))
988 (bury-buffer pmail-buffer))
989 (switch-to-buffer (other-buffer buffer-to-bury))
990 (bury-buffer buffer-to-bury)))
991
992(defun pmail-summary-quit ()
993 "Quit out of Pmail and Pmail summary."
994 (interactive)
995 (pmail-summary-wipe)
996 (pmail-quit))
997
998(defun pmail-summary-wipe ()
999 "Kill and wipe away Pmail summary, remaining within Pmail."
1000 (interactive)
1001 (save-excursion (set-buffer pmail-buffer) (setq pmail-summary-buffer nil))
1002 (let ((local-pmail-buffer pmail-view-buffer))
1003 (kill-buffer (current-buffer))
1004 ;; Delete window if not only one.
1005 (if (not (eq (selected-window) (next-window nil 'no-minibuf)))
1006 (delete-window))
1007 ;; Switch windows to the pmail buffer, or switch to it in this window.
1008 (pop-to-buffer local-pmail-buffer)))
1009
1010(defun pmail-summary-expunge ()
1011 "Actually erase all deleted messages and recompute summary headers."
1012 (interactive)
1013 (set-buffer pmail-buffer)
1014 (pmail-expunge)
1015 (set-buffer pmail-summary-buffer))
1016
1017(defun pmail-summary-expunge-and-save ()
1018 "Expunge and save PMAIL file."
1019 (interactive)
1020 (set-buffer pmail-buffer)
1021 (pmail-expunge)
1022 (save-buffer)
1023 (set-buffer pmail-summary-buffer)
1024 (set-buffer-modified-p nil))
1025
1026(defun pmail-summary-get-new-mail (&optional file-name)
1027 "Get new mail and recompute summary headers.
1028
1029Optionally you can specify the file to get new mail from. In this case,
1030the file of new mail is not changed or deleted. Noninteractively, you can
1031pass the inbox file name as an argument. Interactively, a prefix
1032argument says to read a file name and use that file as the inbox."
1033 (interactive
1034 (list (if current-prefix-arg
1035 (read-file-name "Get new mail from file: "))))
1036 (let (current-message new-mail)
1037 (with-current-buffer pmail-buffer
1038 (setq new-mail (pmail-get-new-mail file-name)
1039 current-message pmail-current-message))
1040 ;; If new mail was found, display of the correct message was
1041 ;; done elsewhere.
1042 (unless new-mail
1043 (pmail-summary-goto-msg current-message nil t))))
1044
1045(defun pmail-summary-input (filename)
1046 "Run Pmail on file FILENAME."
1047 (interactive "FRun pmail on PMAIL file: ")
1048 ;; We switch windows here, then display the other Pmail file there.
1049 (pop-to-buffer pmail-buffer)
1050 (pmail filename))
1051
1052(defun pmail-summary-first-message ()
1053 "Show first message in Pmail file from summary buffer."
1054 (interactive)
1055 (with-no-warnings
1056 (beginning-of-buffer)))
1057
1058(defun pmail-summary-last-message ()
1059 "Show last message in Pmail file from summary buffer."
1060 (interactive)
1061 (with-no-warnings
1062 (end-of-buffer))
1063 (forward-line -1))
1064
e131541f
PR
1065(defvar pmail-summary-edit-map
1066 (let ((map (nconc (make-sparse-keymap) text-mode-map)))
1067 (define-key map "\C-c\C-c" 'pmail-cease-edit)
1068 (define-key map "\C-c\C-]" 'pmail-abort-edit)
1069 map)
1070 "Mode map to use when editing the pmail summary.")
1071
1072(defun pmail-summary-edit-current-message ()
1073 "Edit the contents of this message."
1074 (interactive)
1075 (pop-to-buffer pmail-buffer)
1076 (pmail-edit-current-message)
1077 (use-local-map pmail-summary-edit-map))
1078
1079(defun pmail-summary-cease-edit ()
1080 "Finish editing message, then go back to Pmail summary buffer."
1081 (interactive)
1082 (pmail-cease-edit)
1083 (pop-to-buffer pmail-summary-buffer))
1084
1085(defun pmail-summary-abort-edit ()
1086 "Abort edit of current message; restore original contents.
1087Go back to summary buffer."
1088 (interactive)
1089 (pmail-abort-edit)
1090 (pop-to-buffer pmail-summary-buffer))
1091
1092(defun pmail-summary-search-backward (regexp &optional n)
1093 "Show message containing next match for REGEXP.
1094Prefix argument gives repeat count; negative argument means search
1095backwards (through earlier messages).
1096Interactively, empty argument means use same regexp used last time."
1097 (interactive
1098 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
1099 (prompt
1100 (concat (if reversep "Reverse " "") "Pmail search (regexp"))
1101 regexp)
1102 (setq prompt
1103 (concat prompt
1104 (if pmail-search-last-regexp
1105 (concat ", default "
1106 pmail-search-last-regexp "): ")
1107 "): ")))
1108 (setq regexp (read-string prompt))
1109 (cond ((not (equal regexp ""))
1110 (setq pmail-search-last-regexp regexp))
1111 ((not pmail-search-last-regexp)
1112 (error "No previous Pmail search string")))
1113 (list pmail-search-last-regexp
1114 (prefix-numeric-value current-prefix-arg))))
1115 ;; Don't use save-excursion because that prevents point from moving
1116 ;; properly in the summary buffer.
1117 (let ((buffer (current-buffer)))
1118 (unwind-protect
1119 (progn
1120 (set-buffer pmail-buffer)
1121 (pmail-search regexp (- n)))
1122 (set-buffer buffer))))
1123
1124(defun pmail-summary-search (regexp &optional n)
1125 "Show message containing next match for REGEXP.
1126Prefix argument gives repeat count; negative argument means search
1127backwards (through earlier messages).
1128Interactively, empty argument means use same regexp used last time."
1129 (interactive
1130 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
1131 (prompt
1132 (concat (if reversep "Reverse " "") "Pmail search (regexp"))
1133 regexp)
1134 (setq prompt
1135 (concat prompt
1136 (if pmail-search-last-regexp
1137 (concat ", default "
1138 pmail-search-last-regexp "): ")
1139 "): ")))
1140 (setq regexp (read-string prompt))
1141 (cond ((not (equal regexp ""))
1142 (setq pmail-search-last-regexp regexp))
1143 ((not pmail-search-last-regexp)
1144 (error "No previous Pmail search string")))
1145 (list pmail-search-last-regexp
1146 (prefix-numeric-value current-prefix-arg))))
1147 ;; Don't use save-excursion because that prevents point from moving
1148 ;; properly in the summary buffer.
1149 (let ((buffer (current-buffer)))
1150 (unwind-protect
1151 (progn
1152 (set-buffer pmail-buffer)
1153 (pmail-search regexp n))
1154 (set-buffer buffer))))
1155
1156(defun pmail-summary-toggle-header ()
1157 "Show original message header if pruned header currently shown, or vice versa."
1158 (interactive)
1159 (with-current-buffer pmail-buffer
1160 (pmail-toggle-header)))
1161
1162(defun pmail-summary-add-label (label)
1163 "Add LABEL to labels associated with current Pmail message.
1164Completion is performed over known labels when reading."
1165 (interactive (list (with-current-buffer pmail-buffer
1166 (pmail-read-label "Add label"))))
1167 (with-current-buffer pmail-buffer
1168 (pmail-add-label label)))
1169
1170(defun pmail-summary-kill-label (label)
1171 "Remove LABEL from labels associated with current Pmail message.
1172Completion is performed over known labels when reading."
1173 (interactive (list (with-current-buffer pmail-buffer
1174 (pmail-read-label "Kill label" t))))
1175 (with-current-buffer pmail-buffer
1176 (pmail-kill-label label)))
1177\f
1178;;;; *** Pmail Summary Mailing Commands ***
1179
1180(defun pmail-summary-override-mail-send-and-exit ()
1181 "Replace bindings to 'mail-send-and-exit with 'pmail-summary-send-and-exit"
1182 (use-local-map (copy-keymap (current-local-map)))
1183 (dolist (key (where-is-internal 'mail-send-and-exit))
1184 (define-key (current-local-map) key 'pmail-summary-send-and-exit)))
1185
1186(defun pmail-summary-mail ()
1187 "Send mail in another window.
1188While composing the message, use \\[mail-yank-original] to yank the
1189original message into it."
1190 (interactive)
1191 (let ((window (get-buffer-window pmail-buffer)))
1192 (if window
1193 (select-window window)
1194 (set-buffer pmail-buffer)))
1195 (pmail-start-mail nil nil nil nil nil (current-buffer))
1196 (pmail-summary-override-mail-send-and-exit))
1197
1198(defun pmail-summary-continue ()
1199 "Continue composing outgoing message previously being composed."
1200 (interactive)
1201 (let ((window (get-buffer-window pmail-buffer)))
1202 (if window
1203 (select-window window)
1204 (set-buffer pmail-buffer)))
1205 (pmail-start-mail t))
1206
1207(defun pmail-summary-reply (just-sender)
1208 "Reply to the current message.
1209Normally include CC: to all other recipients of original message;
1210prefix argument means ignore them. While composing the reply,
1211use \\[mail-yank-original] to yank the original message into it."
1212 (interactive "P")
1213 (let ((window (get-buffer-window pmail-view-buffer)))
1214 (if window
1215 (select-window window)
1216 (set-buffer pmail-view-buffer)))
1217 (pmail-reply just-sender)
1218 (pmail-summary-override-mail-send-and-exit))
1219
1220(defun pmail-summary-retry-failure ()
1221 "Edit a mail message which is based on the contents of the current message.
1222For a message rejected by the mail system, extract the interesting headers and
1223the body of the original message; otherwise copy the current message."
1224 (interactive)
1225 (let ((window (get-buffer-window pmail-buffer)))
1226 (if window
1227 (select-window window)
1228 (set-buffer pmail-buffer)))
1229 (pmail-retry-failure)
1230 (pmail-summary-override-mail-send-and-exit))
1231
1232(defun pmail-summary-send-and-exit ()
1233 "Send mail reply and return to summary buffer."
1234 (interactive)
1235 (mail-send-and-exit t))
1236
1237(defun pmail-summary-forward (resend)
1238 "Forward the current message to another user.
1239With prefix argument, \"resend\" the message instead of forwarding it;
1240see the documentation of `pmail-resend'."
1241 (interactive "P")
1242 (save-excursion
1243 (let ((window (get-buffer-window pmail-buffer)))
1244 (if window
1245 (select-window window)
1246 (set-buffer pmail-buffer)))
1247 (pmail-forward resend)
1248 (pmail-summary-override-mail-send-and-exit)))
1249
1250(defun pmail-summary-resend ()
1251 "Resend current message using `pmail-resend'."
1252 (interactive)
1253 (save-excursion
1254 (let ((window (get-buffer-window pmail-buffer)))
1255 (if window
1256 (select-window window)
1257 (set-buffer pmail-buffer)))
1258 (call-interactively 'pmail-resend)))
1259\f
1260;;;; Summary output commands.
1261
1262(defun pmail-summary-output-to-pmail-file (&optional file-name n)
1263 "Append the current message to an Pmail file named FILE-NAME.
1264If the file does not exist, ask if it should be created.
1265If file is being visited, the message is appended to the Emacs
1266buffer visiting that file.
1267
1268A prefix argument N says to output N consecutive messages
1269starting with the current one. Deleted messages are skipped and don't count."
1270 (interactive
1271 (progn (require 'pmailout)
1272 (list (pmail-output-read-file-name)
1273 (prefix-numeric-value current-prefix-arg))))
1274 (let ((i 0) prev-msg)
1275 (while
1276 (and (< i n)
1277 (progn (pmail-summary-goto-msg)
1278 (not (eq prev-msg
1279 (setq prev-msg
1280 (with-current-buffer pmail-buffer
1281 pmail-current-message))))))
1282 (setq i (1+ i))
1283 (with-current-buffer pmail-buffer
1284 (let ((pmail-delete-after-output nil))
1285 (pmail-output-to-pmail-file file-name 1)))
1286 (if pmail-delete-after-output
1287 (pmail-summary-delete-forward nil)
1288 (if (< i n)
1289 (pmail-summary-next-msg 1))))))
1290
1291(defun pmail-summary-output (&optional file-name n)
1292 "Append this message to Unix mail file named FILE-NAME.
1293
1294A prefix argument N says to output N consecutive messages
1295starting with the current one. Deleted messages are skipped and don't count."
1296 (interactive
1297 (progn (require 'pmailout)
1298 (list (pmail-output-read-file-name)
1299 (prefix-numeric-value current-prefix-arg))))
1300 (let ((i 0) prev-msg)
1301 (while
1302 (and (< i n)
1303 (progn (pmail-summary-goto-msg)
1304 (not (eq prev-msg
1305 (setq prev-msg
1306 (with-current-buffer pmail-buffer
1307 pmail-current-message))))))
1308 (setq i (1+ i))
1309 (with-current-buffer pmail-buffer
1310 (let ((pmail-delete-after-output nil))
1311 (pmail-output file-name 1)))
1312 (if pmail-delete-after-output
1313 (pmail-summary-delete-forward nil)
1314 (if (< i n)
1315 (pmail-summary-next-msg 1))))))
1316
1317(defun pmail-summary-output-menu ()
1318 "Output current message to another Pmail file, chosen with a menu.
1319Also set the default for subsequent \\[pmail-output-to-pmail-file] commands.
1320The variables `pmail-secondary-file-directory' and
1321`pmail-secondary-file-regexp' control which files are offered in the menu."
1322 (interactive)
1323 (save-excursion
1324 (set-buffer pmail-buffer)
1325 (let ((pmail-delete-after-output nil))
1326 (call-interactively 'pmail-output-menu)))
1327 (if pmail-delete-after-output
1328 (pmail-summary-delete-forward nil)))
1329
1330(defun pmail-summary-construct-io-menu ()
1331 (let ((files (pmail-find-all-files pmail-secondary-file-directory)))
1332 (if files
1333 (progn
1334 (define-key pmail-summary-mode-map [menu-bar classify input-menu]
1335 (cons "Input Pmail File"
1336 (pmail-list-to-menu "Input Pmail File"
1337 files
1338 'pmail-summary-input)))
1339 (define-key pmail-summary-mode-map [menu-bar classify output-menu]
1340 (cons "Output Pmail File"
1341 (pmail-list-to-menu "Output Pmail File"
1342 files
1343 'pmail-summary-output-to-pmail-file))))
1344 (define-key pmail-summary-mode-map [menu-bar classify input-menu]
1345 '("Input Pmail File" . pmail-disable-menu))
1346 (define-key pmail-summary-mode-map [menu-bar classify output-menu]
1347 '("Output Pmail File" . pmail-disable-menu)))))
1348
1349(defun pmail-summary-output-body (&optional file-name)
1350 "Write this message body to the file FILE-NAME.
1351FILE-NAME defaults, interactively, from the Subject field of the message."
1352 (interactive)
1353 (save-excursion
1354 (set-buffer pmail-buffer)
1355 (let ((pmail-delete-after-output nil))
1356 (if file-name
1357 (pmail-output-body-to-file file-name)
1358 (call-interactively 'pmail-output-body-to-file))))
1359 (if pmail-delete-after-output
1360 (pmail-summary-delete-forward nil)))
1361\f
1362;; Sorting messages in Pmail Summary buffer.
1363
1364(defun pmail-summary-sort-by-date (reverse)
1365 "Sort messages of current Pmail summary by date.
1366If prefix argument REVERSE is non-nil, sort them in reverse order."
1367 (interactive "P")
1368 (pmail-sort-from-summary (function pmail-sort-by-date) reverse))
1369
1370(defun pmail-summary-sort-by-subject (reverse)
1371 "Sort messages of current Pmail summary by subject.
1372If prefix argument REVERSE is non-nil, sort them in reverse order."
1373 (interactive "P")
1374 (pmail-sort-from-summary (function pmail-sort-by-subject) reverse))
1375
1376(defun pmail-summary-sort-by-author (reverse)
1377 "Sort messages of current Pmail summary by author.
1378If prefix argument REVERSE is non-nil, sort them in reverse order."
1379 (interactive "P")
1380 (pmail-sort-from-summary (function pmail-sort-by-author) reverse))
1381
1382(defun pmail-summary-sort-by-recipient (reverse)
1383 "Sort messages of current Pmail summary by recipient.
1384If prefix argument REVERSE is non-nil, sort them in reverse order."
1385 (interactive "P")
1386 (pmail-sort-from-summary (function pmail-sort-by-recipient) reverse))
1387
1388(defun pmail-summary-sort-by-correspondent (reverse)
1389 "Sort messages of current Pmail summary by other correspondent.
1390If prefix argument REVERSE is non-nil, sort them in reverse order."
1391 (interactive "P")
1392 (pmail-sort-from-summary (function pmail-sort-by-correspondent) reverse))
1393
1394(defun pmail-summary-sort-by-lines (reverse)
1395 "Sort messages of current Pmail summary by lines of the message.
1396If prefix argument REVERSE is non-nil, sort them in reverse order."
1397 (interactive "P")
1398 (pmail-sort-from-summary (function pmail-sort-by-lines) reverse))
1399
1400(defun pmail-summary-sort-by-labels (reverse labels)
1401 "Sort messages of current Pmail summary by labels.
1402If prefix argument REVERSE is non-nil, sort them in reverse order.
1403KEYWORDS is a comma-separated list of labels."
1404 (interactive "P\nsSort by labels: ")
1405 (pmail-sort-from-summary
1406 (function (lambda (reverse)
1407 (pmail-sort-by-labels reverse labels)))
1408 reverse))
1409
1410(defun pmail-sort-from-summary (sortfun reverse)
1411 "Sort Pmail messages from Summary buffer and update it after sorting."
1412 (require 'pmailsort)
1413 (let ((selwin (selected-window)))
1414 (unwind-protect
1415 (progn (pop-to-buffer pmail-buffer)
1416 (funcall sortfun reverse))
1417 (select-window selwin))))
1418
1419(defun pmail-summary-get-sender (n)
1420 "Return the sender for message N.
1421If sender matches `pmail-user-mail-address-regexp' or
1422`user-mail-address', return the to-address instead."
1423 (let ((sender (pmail-desc-get-sender n)))
1424 (if (or (null sender)
1425 (and pmail-user-mail-address-regexp
1426 (string-match pmail-user-mail-address-regexp sender)))
1427 ;; Either no sender known, or it's this user.
1428 (save-restriction
1429 (narrow-to-region (pmail-desc-get-start n)
1430 (pmail-desc-get-end n))
1431 (concat "to: " (mail-strip-quoted-names
1432 (pmail-header-get-header "to"))))
1433 sender)))
1434
1435(defun pmail-summary-get-line-count (n)
1436 "Return a string containing the number of lines in message N.
1437If `pmail-summary-line-count-flag' is nil, return the empty string."
1438 (if pmail-summary-line-count-flag
1439 (let ((lines (pmail-desc-get-line-count n)))
1440 (format (cond ((<= lines 9) " [%d]")
1441 ((<= lines 99) " [%d]")
1442 ((<= lines 999) " [%3d]")
1443 (t "[%d]"))
1444 lines))
1445 ""))
1446
1447(defun pmail-summary-get-summary-attributes (n)
1448 "Return the attribute character codes for message N.
1449`-' means an unseen message, `D' means marked for deletion."
1450 (format "%s%s%s%s%s"
1451 (cond ((pmail-desc-attr-p pmail-desc-unseen-index n) "-")
1452 ((pmail-desc-attr-p pmail-desc-deleted-index n) "D")
1453 (t " "))
1454 (or (pmail-desc-get-attr-code pmail-desc-answered-index n) " ")
1455 (or (pmail-desc-get-attr-code pmail-desc-filed-index n) " ")
1456 (or (pmail-desc-get-attr-code pmail-desc-edited-index n) " ")
1457 (or (pmail-desc-get-attr-code pmail-desc-stored-index n) " ")))
1458
1459(defun pmail-summary-get-summary-line (n)
1460 "Return a summary line for message N."
1461 (let (keywords str subj)
1462 (dolist (keyword (pmail-desc-get-keywords n))
1463 (when (and (pmail-keyword-p keyword)
1464 (not (pmail-attribute-p keyword)))
1465 (setq keywords (cons keyword keywords))))
1466 (setq keywords (nreverse keywords)
1467 str (if keywords
1468 (concat "{ " (mapconcat 'identity keywords " ") " } ")
1469 "")
1470 subj (replace-regexp-in-string "\\s-+" " "
1471 (pmail-desc-get-subject n)))
1472 (funcall pmail-summary-line-decoder
1473 (format "%5s%s%6s %25.25s%s %s\n"
1474 n
1475 (pmail-summary-get-summary-attributes n)
1476 (concat (pmail-desc-get-day-number n) "-"
1477 (pmail-desc-get-month n))
1478 (pmail-summary-get-sender n)
1479 (pmail-summary-get-line-count n)
1480 (concat str subj)))))
1481
1482(defun pmail-summary-update (n)
1483 "Rewrite the summary line for message N."
1484 (with-current-buffer pmail-buffer
1485 ;; we need to do this in the pmail-buffer lest the keywords are
1486 ;; not recognized
1487 (let ((summary (pmail-summary-get-summary-line n)))
1488 (with-current-buffer pmail-summary-buffer
1489 (save-excursion
1490 (let ((buffer-read-only nil))
1491 (pmail-summary-goto-msg n)
1492 ;; summary line includes newline at the end
1493 (delete-region (point) (1+ (line-end-position)))
1494 (insert summary)))))))
1495
1496(provide 'pmailsum)
1497
0faeefbb 1498;; arch-tag: 80b0a27a-a50d-4f37-9466-83d32d1e0ca8
e131541f 1499;;; pmailsum.el ends here