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