1;;; rmailsum.el --- make summary buffers for the mail reader 2 3;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. 4 5;; Maintainer: FSF 6;; Keywords: mail 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to 22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23 24;;; Commentary: 25 26;; Extended by Bob Weiner of Motorola 27;; Provided all commands from rmail-mode in rmail-summary-mode and made key 28;; bindings in both modes wholly compatible. 29 30;;; Code: 31 32;; Entry points for making a summary buffer. 33 34;; Regenerate the contents of the summary 35;; using the same selection criterion as last time. 36;; M-x revert-buffer in a summary buffer calls this function. 37(defun rmail-update-summary (&rest ignore) 38 (apply (car rmail-summary-redo) (cdr rmail-summary-redo))) 39 40(defun rmail-summary () 41 "Display a summary of all messages, one line per message." 42 (interactive) 43 (rmail-new-summary "All" '(rmail-summary) nil)) 44 45(defun rmail-summary-by-labels (labels) 46 "Display a summary of all messages with one or more LABELS. 47LABELS should be a string containing the desired labels, separated by commas." 48 (interactive "sLabels to summarize by: ") 49 (if (string= labels "") 50 (setq labels (or rmail-last-multi-labels 51 (error "No label specified")))) 52 (setq rmail-last-multi-labels labels) 53 (rmail-new-summary (concat "labels " labels) 54 (list 'rmail-summary-by-labels labels) 55 'rmail-message-labels-p 56 (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) 57 58(defun rmail-summary-by-recipients (recipients &optional primary-only) 59 "Display a summary of all messages with the given RECIPIENTS. 60Normally checks the To, From and Cc fields of headers; 61but if PRIMARY-ONLY is non-nil (prefix arg given), 62 only look in the To and From fields. 63RECIPIENTS is a string of regexps separated by commas." 64 (interactive "sRecipients to summarize by: \nP") 65 (rmail-new-summary 66 (concat "recipients " recipients) 67 (list 'rmail-summary-by-recipients recipients primary-only) 68 'rmail-message-recipients-p 69 (mail-comma-list-regexp recipients) primary-only)) 70 71(defun rmail-summary-by-regexp (regexp) 72 "Display a summary of all messages according to regexp REGEXP. 73If the regular expression is found in the header of the message 74\(including in the date and other lines, as well as the subject line), 75Emacs will list the header line in the RMAIL-summary." 76 (interactive "sRegexp to summarize by: ") 77 (if (string= regexp "") 78 (setq regexp (or rmail-last-regexp 79 (error "No regexp specified.")))) 80 (setq rmail-last-regexp regexp) 81 (rmail-new-summary (concat "regexp " regexp) 82 (list 'rmail-summary-by-regexp regexp) 83 'rmail-message-regexp-p 84 regexp)) 85 86;; rmail-summary-by-topic 87;; 1989 R.A. Schnitzler 88 89(defun rmail-summary-by-topic (subject &optional whole-message) 90 "Display a summary of all messages with the given SUBJECT. 91Normally checks the Subject field of headers; 92but if WHOLE-MESSAGE is non-nil (prefix arg given), 93 look in the whole message. 94SUBJECT is a string of regexps separated by commas." 95 (interactive "sTopics to summarize by: \nP") 96 (rmail-new-summary 97 (concat "about " subject) 98 (list 'rmail-summary-by-topic subject whole-message) 99 'rmail-message-subject-p 100 (mail-comma-list-regexp subject) whole-message)) 101 102(defun rmail-message-subject-p (msg subject &optional whole-message) 103 (save-restriction 104 (goto-char (rmail-msgbeg msg)) 105 (search-forward "\n*** EOOH ***\n") 106 (narrow-to-region 107 (point) 108 (progn (search-forward (if whole-message "\^_" "\n\n")) (point))) 109 (goto-char (point-min)) 110 (if whole-message (re-search-forward subject nil t) 111 (string-match subject (or (mail-fetch-field "Subject") "")) ))) 112 113(defun rmail-summary-by-senders (senders) 114 "Display a summary of all messages with the given SENDERS. 115SENDERS is a string of names separated by commas." 116 (interactive "sSenders to summarize by: ") 117 (rmail-new-summary 118 (concat "senders " senders) 119 (list 'rmail-summary-by-senders senders) 120 'rmail-message-senders-p 121 (mail-comma-list-regexp senders))) 122 123(defun rmail-message-senders-p (msg senders) 124 (save-restriction 125 (goto-char (rmail-msgbeg msg)) 126 (search-forward "\n*** EOOH ***\n") 127 (narrow-to-region (point) (progn (search-forward "\n\n") (point))) 128 (string-match senders (or (mail-fetch-field "From") "")))) 129 130;; General making of a summary buffer. 131 132(defvar rmail-summary-symbol-number 0) 133 134(defun rmail-new-summary (description redo-form function &rest args) 135 "Create a summary of selected messages. 136DESCRIPTION makes part of the mode line of the summary buffer. 137For each message, FUNCTION is applied to the message number and ARGS... 138and if the result is non-nil, that message is included. 139nil for FUNCTION means all messages." 140 (message "Computing summary lines...") 141 (let (sumbuf mesg was-in-summary) 142 (save-excursion 143 ;; Go to the Rmail buffer. 144 (if (eq major-mode 'rmail-summary-mode) 145 (progn 146 (setq was-in-summary t) 147 (set-buffer rmail-buffer))) 148 ;; Find its summary buffer, or make one. 149 (setq sumbuf 150 (if (and rmail-summary-buffer 151 (buffer-name rmail-summary-buffer)) 152 rmail-summary-buffer 153 (generate-new-buffer (concat (buffer-name) "-summary")))) 154 (setq mesg rmail-current-message) 155 ;; Filter the messages; make or get their summary lines. 156 (let ((summary-msgs ()) 157 (new-summary-line-count 0)) 158 (let ((msgnum 1) 159 (buffer-read-only nil) 160 (old-min (point-min-marker)) 161 (old-max (point-max-marker))) 162 ;; Can't use save-restriction here; that doesn't work if we 163 ;; plan to modify text outside the original restriction. 164 (save-excursion 165 (widen) 166 (goto-char (point-min)) 167 (while (>= rmail-total-messages msgnum) 168 (if (or (null function) 169 (apply function (cons msgnum args))) 170 (setq summary-msgs 171 (cons (cons msgnum (rmail-make-summary-line msgnum)) 172 summary-msgs))) 173 (setq msgnum (1+ msgnum))) 174 (setq summary-msgs (nreverse summary-msgs))) 175 (narrow-to-region old-min old-max)) 176 ;; Temporarily, while summary buffer is unfinished, 177 ;; we "don't have" a summary. 178 (setq rmail-summary-buffer nil) 179 (save-excursion 180 (let ((rbuf (current-buffer)) 181 (total rmail-total-messages)) 182 (set-buffer sumbuf) 183 ;; Set up the summary buffer's contents. 184 (let ((buffer-read-only nil)) 185 (erase-buffer) 186 (while summary-msgs 187 (princ (cdr (car summary-msgs)) sumbuf) 188 (setq summary-msgs (cdr summary-msgs))) 189 (goto-char (point-min))) 190 ;; Set up the rest of its state and local variables. 191 (setq buffer-read-only t) 192 (rmail-summary-mode) 193 (make-local-variable 'minor-mode-alist) 194 (setq minor-mode-alist (list '(t (concat ": " description)))) 195 (setq rmail-buffer rbuf 196 rmail-summary-redo redo-form 197 rmail-total-messages total)))) 198 (setq rmail-summary-buffer sumbuf)) 199 ;; Now display the summary buffer and go to the right place in it. 200 (or was-in-summary 201 (pop-to-buffer sumbuf)) 202 (rmail-summary-goto-msg mesg t t) 203 (message "Computing summary lines...done"))) 204 205;; Low levels of generating a summary. 206 207(defun rmail-make-summary-line (msg) 208 (let ((line (or (aref rmail-summary-vector (1- msg)) 209 (progn 210 (setq new-summary-line-count 211 (1+ new-summary-line-count)) 212 (if (zerop (% new-summary-line-count 10)) 213 (message "Computing summary lines...%d" 214 new-summary-line-count)) 215 (rmail-make-summary-line-1 msg))))) 216 ;; Fix up the part of the summary that says "deleted" or "unseen". 217 (aset line 4 218 (if (rmail-message-deleted-p msg) ?\D 219 (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg)))) 220 ?\- ?\ ))) 221 line)) 222 223(defun rmail-make-summary-line-1 (msg) 224 (goto-char (rmail-msgbeg msg)) 225 (let* ((lim (save-excursion (forward-line 2) (point))) 226 pos 227 (labels 228 (progn 229 (forward-char 3) 230 (concat 231; (if (save-excursion (re-search-forward ",answered," lim t)) 232; "*" "") 233; (if (save-excursion (re-search-forward ",filed," lim t)) 234; "!" "") 235 (if (progn (search-forward ",,") (eolp)) 236 "" 237 (concat "{" 238 (buffer-substring (point) 239 (progn (end-of-line) (point))) 240 "} "))))) 241 (line 242 (progn 243 (forward-line 1) 244 (if (looking-at "Summary-line: ") 245 (progn 246 (goto-char (match-end 0)) 247 (setq line 248 (buffer-substring (point) 249 (progn (forward-line 1) (point))))))))) 250 ;; Obsolete status lines lacking a # should be flushed. 251 (and line 252 (not (string-match "#" line)) 253 (progn 254 (delete-region (point) 255 (progn (forward-line -1) (point))) 256 (setq line nil))) 257 ;; If we didn't get a valid status line from the message, 258 ;; make a new one and put it in the message. 259 (or line 260 (let* ((case-fold-search t) 261 (next (rmail-msgend msg)) 262 (beg (if (progn (goto-char (rmail-msgbeg msg)) 263 (search-forward "\n*** EOOH ***\n" next t)) 264 (point) 265 (forward-line 1) 266 (point))) 267 (end (progn (search-forward "\n\n" nil t) (point)))) 268 (save-restriction 269 (narrow-to-region beg end) 270 (goto-char beg) 271 (setq line (rmail-make-basic-summary-line))) 272 (goto-char (rmail-msgbeg msg)) 273 (forward-line 2) 274 (insert "Summary-line: " line))) 275 (setq pos (string-match "#" line)) 276 (aset rmail-summary-vector (1- msg) 277 (concat (format "%4d " msg) 278 (substring line 0 pos) 279 labels 280 (substring line (1+ pos)))))) 281 282(defun rmail-make-basic-summary-line () 283 (goto-char (point-min)) 284 (concat (save-excursion 285 (if (not (re-search-forward "^Date:" nil t)) 286 " " 287 (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" 288 (save-excursion (end-of-line) (point)) t) 289 (format "%2d-%3s" 290 (string-to-int (buffer-substring 291 (match-beginning 2) 292 (match-end 2))) 293 (buffer-substring 294 (match-beginning 4) (match-end 4)))) 295 ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" 296 (save-excursion (end-of-line) (point)) t) 297 (format "%2d-%3s" 298 (string-to-int (buffer-substring 299 (match-beginning 4) 300 (match-end 4))) 301 (buffer-substring 302 (match-beginning 2) (match-end 2)))) 303 (t "??????")))) 304 " " 305 (save-excursion 306 (if (not (re-search-forward "^From:[ \t]*" nil t)) 307 " " 308 (let* ((from (mail-strip-quoted-names 309 (buffer-substring 310 (1- (point)) 311 ;; Get all the lines of the From field 312 ;; so that we get a whole comment if there is one, 313 ;; so that mail-strip-quoted-names can discard it. 314 (let ((opoint (point))) 315 (while (progn (forward-line 1) 316 (looking-at "[ \t]"))) 317 ;; Back up over newline, then trailing spaces or tabs 318 (forward-char -1) 319 (skip-chars-backward " \t") 320 (point))))) 321 len mch lo) 322 (if (string-match (concat "^" 323 (regexp-quote (user-login-name)) 324 "\\($\\|@\\)") 325 from) 326 (save-excursion 327 (goto-char (point-min)) 328 (if (not (re-search-forward "^To:[ \t]*" nil t)) 329 nil 330 (setq from 331 (concat "to: " 332 (mail-strip-quoted-names 333 (buffer-substring 334 (point) 335 (progn (end-of-line) 336 (skip-chars-backward " \t") 337 (point))))))))) 338 (setq len (length from)) 339 (setq mch (string-match "[@%]" from)) 340 (format "%25s" 341 (if (or (not mch) (<= len 25)) 342 (substring from (max 0 (- len 25))) 343 (substring from 344 (setq lo (cond ((< (- mch 14) 0) 0) 345 ((< len (+ mch 11)) 346 (- len 25)) 347 (t (- mch 14)))) 348 (min len (+ lo 25)))))))) 349 " #" 350 (if (re-search-forward "^Subject:" nil t) 351 (progn (skip-chars-forward " \t") 352 (buffer-substring (point) 353 (progn (end-of-line) 354 (point)))) 355 (re-search-forward "[\n][\n]+" nil t) 356 (buffer-substring (point) (progn (end-of-line) (point)))) 357 "\n")) 358 359;; Simple motion in a summary buffer. 360 361(defun rmail-summary-next-all (&optional number) 362 (interactive "p") 363 (forward-line (if number number 1)) 364 (display-buffer rmail-buffer)) 365 366(defun rmail-summary-previous-all (&optional number) 367 (interactive "p") 368 (forward-line (- (if number number 1))) 369 (display-buffer rmail-buffer)) 370 371(defun rmail-summary-next-msg (&optional number) 372 "Display next non-deleted msg from rmail file. 373With optional prefix argument NUMBER, moves forward this number of non-deleted 374messages, or backward if NUMBER is negative." 375 (interactive "p") 376 (forward-line 0) 377 (and (> number 0) (end-of-line)) 378 (let ((count (if (< number 0) (- number) number)) 379 (search (if (> number 0) 're-search-forward 're-search-backward)) 380 (non-del-msg-found nil)) 381 (while (and (> count 0) (setq non-del-msg-found 382 (or (funcall search "^....[^D]" nil t) 383 non-del-msg-found))) 384 (setq count (1- count)))) 385 (beginning-of-line) 386 (display-buffer rmail-buffer)) 387 388(defun rmail-summary-previous-msg (&optional number) 389 (interactive "p") 390 (rmail-summary-next-msg (- (if number number 1)))) 391 392(defun rmail-summary-next-labeled-message (n labels) 393 "Show next message with LABEL. Defaults to last labels used. 394With prefix argument N moves forward N messages with these labels." 395 (interactive "p\nsMove to next msg with labels: ") 396 (save-excursion 397 (set-buffer rmail-buffer) 398 (rmail-next-labeled-message n labels))) 399 400(defun rmail-summary-previous-labeled-message (n labels) 401 "Show previous message with LABEL. Defaults to last labels used. 402With prefix argument N moves backward N messages with these labels." 403 (interactive "p\nsMove to previous msg with labels: ") 404 (save-excursion 405 (set-buffer rmail-buffer) 406 (rmail-previous-labeled-message n labels))) 407 408;; Delete and undelete summary commands. 409 410(defun rmail-summary-delete-forward (&optional backward) 411 "Delete this message and move to next nondeleted one. 412Deleted messages stay in the file until the \\[rmail-expunge] command is given. 413With prefix argument, delete and move backward." 414 (interactive "P") 415 (let (end) 416 (rmail-summary-goto-msg) 417 (pop-to-buffer rmail-buffer) 418 (rmail-delete-message) 419 (let ((del-msg rmail-current-message)) 420 (pop-to-buffer rmail-summary-buffer) 421 (rmail-summary-mark-deleted del-msg) 422 (while (and (not (if backward (bobp) (eobp))) 423 (save-excursion (beginning-of-line) 424 (looking-at " +[0-9]+D"))) 425 (forward-line (if backward -1 1)))))) 426 427(defun rmail-summary-delete-backward () 428 "Delete this message and move to previous nondeleted one. 429Deleted messages stay in the file until the \\[rmail-expunge] command is given." 430 (interactive) 431 (rmail-summary-delete-forward t)) 432 433(defun rmail-summary-mark-deleted (&optional n undel) 434 (and n (rmail-summary-goto-msg n t t)) 435 (or (eobp) 436 (let ((buffer-read-only nil)) 437 (skip-chars-forward " ") 438 (skip-chars-forward "[0-9]") 439 (if undel 440 (if (looking-at "D") 441 (progn (delete-char 1) (insert " "))) 442 (delete-char 1) 443 (insert "D")))) 444 (beginning-of-line)) 445 446(defun rmail-summary-mark-undeleted (n) 447 (rmail-summary-mark-deleted n t)) 448 449(defun rmail-summary-deleted-p (&optional n) 450 (save-excursion 451 (and n (rmail-summary-goto-msg n nil t)) 452 (skip-chars-forward " ") 453 (skip-chars-forward "[0-9]") 454 (looking-at "D"))) 455 456(defun rmail-summary-undelete (&optional arg) 457 "Undelete current message. 458Optional prefix ARG means undelete ARG previous messages." 459 (interactive "p") 460 (if (/= arg 1) 461 (rmail-summary-undelete-many arg) 462 (let ((buffer-read-only nil) 463 (opoint (point))) 464 (end-of-line) 465 (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) 466 (replace-match "\\1 ") 467 (rmail-summary-goto-msg) 468 (pop-to-buffer rmail-buffer) 469 (and (rmail-message-deleted-p rmail-current-message) 470 (rmail-undelete-previous-message)) 471 (pop-to-buffer rmail-summary-buffer)) 472 (t (goto-char opoint)))))) 473 474(defun rmail-summary-undelete-many (&optional n) 475 "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." 476 (interactive "P") 477 (save-excursion 478 (set-buffer rmail-buffer) 479 (let* ((init-msg (if n rmail-current-message rmail-total-messages)) 480 (rmail-current-message init-msg) 481 (n (or n rmail-total-messages)) 482 (msgs-undeled 0)) 483 (while (and (> rmail-current-message 0) 484 (< msgs-undeled n)) 485 (if (rmail-message-deleted-p rmail-current-message) 486 (progn (rmail-set-attribute "deleted" nil) 487 (setq msgs-undeled (1+ msgs-undeled)))) 488 (setq rmail-current-message (1- rmail-current-message))) 489 (set-buffer rmail-summary-buffer) 490 (setq rmail-current-message init-msg msgs-undeled 0) 491 (while (and (> rmail-current-message 0) 492 (< msgs-undeled n)) 493 (if (rmail-summary-deleted-p rmail-current-message) 494 (progn (rmail-summary-mark-undeleted rmail-current-message) 495 (setq msgs-undeled (1+ msgs-undeled)))) 496 (setq rmail-current-message (1- rmail-current-message)))) 497 (rmail-summary-goto-msg))) 498 499;; Rmail Summary mode is suitable only for specially formatted data. 500(put 'rmail-summary-mode 'mode-class 'special) 501 502(defun rmail-summary-mode () 503 "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary]. 504As commands are issued in the summary buffer, they are applied to the 505corresponding mail messages in the rmail buffer. 506 507All normal editing commands are turned off. 508Instead, nearly all the Rmail mode commands are available, 509though many of them move only among the messages in the summary. 510 511These additional commands exist: 512 513\\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages. 514\\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer. 515 516Commands for sorting the summary: 517 518\\[rmail-summary-sort-by-date] Sort by date. 519\\[rmail-summary-sort-by-subject] Sort by subject. 520\\[rmail-summary-sort-by-author] Sort by author. 521\\[rmail-summary-sort-by-recipient] Sort by recipient. 522\\[rmail-summary-sort-by-correspondent] Sort by correspondent. 523\\[rmail-summary-sort-by-lines] Sort by lines. 524\\[rmail-summary-sort-by-keywords] Sort by keywords." 525 (interactive) 526 (kill-all-local-variables) 527 (setq major-mode 'rmail-summary-mode) 528 (setq mode-name "RMAIL Summary") 529 (setq truncate-lines t) 530 (setq buffer-read-only t) 531 (set-syntax-table text-mode-syntax-table) 532 (make-local-variable 'rmail-buffer) 533 (make-local-variable 'rmail-total-messages) 534 (make-local-variable 'rmail-current-message) 535 (setq rmail-current-message nil) 536 (make-local-variable 'rmail-summary-redo) 537 (setq rmail-summary-redo nil) 538 (make-local-variable 'revert-buffer-function) 539 (make-local-variable 'post-command-hook) 540 (rmail-summary-enable) 541 (run-hooks 'rmail-summary-mode-hook)) 542 543;; Summary features need to be disabled during edit mode. 544(defun rmail-summary-disable () 545 (use-local-map text-mode-map) 546 (remove-hook 'post-command-hook 'rmail-summary-rmail-update) 547 (setq revert-buffer-function nil)) 548 549(defun rmail-summary-enable () 550 (use-local-map rmail-summary-mode-map) 551 (add-hook 'post-command-hook 'rmail-summary-rmail-update) 552 (setq revert-buffer-function 'rmail-update-summary)) 553 554;; Show in Rmail the message described by the summary line that point is on, 555;; but only if the Rmail buffer is already visible. 556;; This is a post-command-hook in summary buffers. 557(defun rmail-summary-rmail-update () 558 (let (buffer-read-only) 559 (save-excursion 560 ;; If at end of buffer, pretend we are on the last text line. 561 (if (eobp) 562 (forward-line -1)) 563 (beginning-of-line) 564 (skip-chars-forward " ") 565 (let ((msg-num (string-to-int (buffer-substring 566 (point) 567 (progn (skip-chars-forward "0-9") 568 (point)))))) 569 (or (eq rmail-current-message msg-num) 570 (let ((window (get-buffer-window rmail-buffer)) 571 (owin (selected-window))) 572 (setq rmail-current-message msg-num) 573 (if (= (following-char) ?-) 574 (progn 575 (delete-char 1) 576 (insert " "))) 577 (if window 578 ;; Using save-window-excursion would cause the new value 579 ;; of point to get lost. 580 (unwind-protect 581 (progn 582 (select-window window) 583 (rmail-show-message msg-num)) 584 (select-window owin)) 585 (save-excursion 586 (set-buffer rmail-buffer) 587 (rmail-show-message msg-num))))))))) 588 589(defvar rmail-summary-mode-map nil) 590 591(if rmail-summary-mode-map 592 nil 593 (setq rmail-summary-mode-map (make-keymap)) 594 (suppress-keymap rmail-summary-mode-map) 595 (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label) 596 (define-key rmail-summary-mode-map "c" 'rmail-summary-continue) 597 (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) 598 (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward) 599 (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message) 600 (define-key rmail-summary-mode-map "f" 'rmail-summary-forward) 601 (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail) 602 (define-key rmail-summary-mode-map "h" 'rmail-summary) 603 (define-key rmail-summary-mode-map "i" 'rmail-summary-input) 604 (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) 605 (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label) 606 (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels) 607 (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary) 608 (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels) 609 (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients) 610 (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp) 611 (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic) 612 (define-key rmail-summary-mode-map "m" 'rmail-summary-mail) 613 (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure) 614 (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) 615 (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all) 616 (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message) 617 (define-key rmail-summary-mode-map "o" 'rmail-summary-output-to-rmail-file) 618 (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output) 619 (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) 620 (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all) 621 (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message) 622 (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) 623 (define-key rmail-summary-mode-map "r" 'rmail-summary-reply) 624 (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save) 625 (define-key rmail-summary-mode-map "\es" 'rmail-summary-search) 626 (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header) 627 (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) 628 (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many) 629 (define-key rmail-summary-mode-map "w" 'rmail-summary-wipe) 630 (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge) 631 (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message) 632 (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message) 633 (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message) 634 (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) 635 (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) 636 (define-key rmail-summary-mode-map "?" 'describe-mode) 637 (define-key rmail-summary-mode-map "\C-c\C-s\C-d" 638 'rmail-summary-sort-by-date) 639 (define-key rmail-summary-mode-map "\C-c\C-s\C-s" 640 'rmail-summary-sort-by-subject) 641 (define-key rmail-summary-mode-map "\C-c\C-s\C-a" 642 'rmail-summary-sort-by-author) 643 (define-key rmail-summary-mode-map "\C-c\C-s\C-r" 644 'rmail-summary-sort-by-recipient) 645 (define-key rmail-summary-mode-map "\C-c\C-s\C-c" 646 'rmail-summary-sort-by-correspondent) 647 (define-key rmail-summary-mode-map "\C-c\C-s\C-l" 648 'rmail-summary-sort-by-lines) 649 (define-key rmail-summary-mode-map "\C-c\C-s\C-k" 650 'rmail-summary-sort-by-keywords) 651 ) 652 653;;; Menu bar bindings. 654 655(define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap)) 656 657(define-key rmail-summary-mode-map [menu-bar classify] 658 (cons "Classify" (make-sparse-keymap "Classify"))) 659 660(define-key rmail-summary-mode-map [menu-bar classify output-inbox] 661 '("Output (inbox)" . rmail-summary-output)) 662 663(define-key rmail-summary-mode-map [menu-bar classify output] 664 '("Output (Rmail)" . rmail-summary-output-to-rmail-file)) 665 666(define-key rmail-summary-mode-map [menu-bar classify kill-label] 667 '("Kill Label" . rmail-summary-kill-label)) 668 669(define-key rmail-summary-mode-map [menu-bar classify add-label] 670 '("Add Label" . rmail-summary-add-label)) 671 672(define-key rmail-summary-mode-map [menu-bar summary] 673 (cons "Summary" (make-sparse-keymap "Summary"))) 674 675(define-key rmail-summary-mode-map [menu-bar summary labels] 676 '("By Labels" . rmail-summary-by-labels)) 677 678(define-key rmail-summary-mode-map [menu-bar summary recipients] 679 '("By Recipients" . rmail-summary-by-recipients)) 680 681(define-key rmail-summary-mode-map [menu-bar summary topic] 682 '("By Topic" . rmail-summary-by-topic)) 683 684(define-key rmail-summary-mode-map [menu-bar summary regexp] 685 '("By Regexp" . rmail-summary-by-regexp)) 686 687(define-key rmail-summary-mode-map [menu-bar summary all] 688 '("All" . rmail-summary)) 689 690(define-key rmail-summary-mode-map [menu-bar mail] 691 (cons "Mail" (make-sparse-keymap "Mail"))) 692 693(define-key rmail-summary-mode-map [menu-bar mail continue] 694 '("Continue" . rmail-summary-continue)) 695 696(define-key rmail-summary-mode-map [menu-bar mail forward] 697 '("Forward" . rmail-summary-forward)) 698 699(define-key rmail-summary-mode-map [menu-bar mail retry] 700 '("Retry" . rmail-summary-retry-failure)) 701 702(define-key rmail-summary-mode-map [menu-bar mail reply] 703 '("Reply" . rmail-summary-reply)) 704 705(define-key rmail-summary-mode-map [menu-bar mail mail] 706 '("Mail" . rmail-summary-mail)) 707 708(define-key rmail-summary-mode-map [menu-bar delete] 709 (cons "Delete" (make-sparse-keymap "Delete"))) 710 711(define-key rmail-summary-mode-map [menu-bar delete expunge/save] 712 '("Expunge/Save" . rmail-summary-expunge-and-save)) 713 714(define-key rmail-summary-mode-map [menu-bar delete expunge] 715 '("Expunge" . rmail-summary-expunge)) 716 717(define-key rmail-summary-mode-map [menu-bar delete undelete] 718 '("Undelete" . rmail-summary-undelete)) 719 720(define-key rmail-summary-mode-map [menu-bar delete delete] 721 '("Delete" . rmail-summary-delete-forward)) 722 723(define-key rmail-summary-mode-map [menu-bar move] 724 (cons "Move" (make-sparse-keymap "Move"))) 725 726(define-key rmail-summary-mode-map [menu-bar move search-back] 727 '("Search Back" . rmail-summary-search-backward)) 728 729(define-key rmail-summary-mode-map [menu-bar move search] 730 '("Search" . rmail-summary-search)) 731 732(define-key rmail-summary-mode-map [menu-bar move previous] 733 '("Previous Nondeleted" . rmail-summary-previous-msg)) 734 735(define-key rmail-summary-mode-map [menu-bar move next] 736 '("Next Nondeleted" . rmail-summary-next-msg)) 737 738(define-key rmail-summary-mode-map [menu-bar move last] 739 '("Last" . rmail-summary-last-message)) 740 741(define-key rmail-summary-mode-map [menu-bar move first] 742 '("First" . rmail-summary-first-message)) 743 744(define-key rmail-summary-mode-map [menu-bar move previous] 745 '("Previous" . rmail-summary-previous-all)) 746 747(define-key rmail-summary-mode-map [menu-bar move next] 748 '("Next" . rmail-summary-next-all)) 749 750(defvar rmail-summary-overlay nil) 751 752(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail) 753 (interactive "P") 754 (if (consp n) (setq n (prefix-numeric-value n))) 755 (if (eobp) (forward-line -1)) 756 (beginning-of-line) 757 (let ((buf rmail-buffer) 758 (cur (point)) 759 message-not-found 760 (curmsg (string-to-int 761 (buffer-substring (point) 762 (min (point-max) (+ 5 (point))))))) 763 ;; If message number N was specified, find that message's line 764 ;; or set message-not-found. 765 ;; If N wasn't specified or that message can't be found. 766 ;; set N by default. 767 (if (not n) 768 (setq n curmsg) 769 (if (< n 1) 770 (progn (message "No preceding message") 771 (setq n 1))) 772 (if (> n rmail-total-messages) 773 (progn (message "No following message") 774 (goto-char (point-max)) 775 (rmail-summary-goto-msg))) 776 (goto-char (point-min)) 777 (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t)) 778 (progn (or nowarn (message "Message %d not found" n)) 779 (setq n curmsg) 780 (setq message-not-found t) 781 (goto-char cur)))) 782 (beginning-of-line) 783 (skip-chars-forward " ") 784 (skip-chars-forward "0-9") 785 (save-excursion (if (= (following-char) ?-) 786 (let ((buffer-read-only nil)) 787 (delete-char 1) 788 (insert " ")))) 789 ;; Make sure we have an overlay to use. 790 (or rmail-summary-overlay 791 (progn 792 (make-local-variable 'rmail-summary-overlay) 793 (setq rmail-summary-overlay (make-overlay (point) (point))))) 794 ;; If this message is in the summary, use the overlay to highlight it. 795 ;; Otherwise, don't highlight anything. 796 (if message-not-found 797 (overlay-put rmail-summary-overlay 'face nil) 798 (move-overlay rmail-summary-overlay 799 (save-excursion (beginning-of-line) (1+ (point))) 800 (save-excursion (end-of-line) (point))) 801 (overlay-put rmail-summary-overlay 'face 'highlight)) 802 (beginning-of-line) 803 (if skip-rmail 804 nil 805 (let ((selwin (selected-window))) 806 (unwind-protect 807 (progn (pop-to-buffer buf) 808 (rmail-show-message n)) 809 (select-window selwin)))))) 810 811(defun rmail-summary-scroll-msg-up (&optional dist) 812 "Scroll the Rmail window forward." 813 (interactive "P") 814 (let ((other-window-scroll-buffer rmail-buffer)) 815 (scroll-other-window dist))) 816 817(defun rmail-summary-scroll-msg-down (&optional dist) 818 "Scroll the Rmail window backward." 819 (interactive "P") 820 (rmail-summary-scroll-msg-up 821 (cond ((eq dist '-) nil) 822 ((null dist) '-) 823 (t (- (prefix-numeric-value dist)))))) 824 825(defun rmail-summary-beginning-of-message () 826 "Show current message from the beginning." 827 (interactive) 828 (pop-to-buffer rmail-buffer) 829 (beginning-of-buffer) 830 (pop-to-buffer rmail-summary-buffer)) 831 832(defun rmail-summary-quit () 833 "Quit out of Rmail and Rmail summary." 834 (interactive) 835 (rmail-summary-wipe) 836 (rmail-quit)) 837 838(defun rmail-summary-wipe () 839 "Kill and wipe away Rmail summary, remaining within Rmail." 840 (interactive) 841 (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil)) 842 (let ((local-rmail-buffer rmail-buffer)) 843 (kill-buffer (current-buffer)) 844 ;; Delete window if not only one. 845 (if (not (eq (selected-window) (next-window nil 'no-minibuf))) 846 (delete-window)) 847 ;; Switch windows to the rmail buffer, or switch to it in this window. 848 (pop-to-buffer local-rmail-buffer))) 849 850(defun rmail-summary-expunge () 851 "Actually erase all deleted messages and recompute summary headers." 852 (interactive) 853 (save-excursion 854 (set-buffer rmail-buffer) 855 (rmail-only-expunge)) 856 (rmail-update-summary)) 857 858(defun rmail-summary-expunge-and-save () 859 "Expunge and save RMAIL file." 860 (interactive) 861 (save-excursion 862 (set-buffer rmail-buffer) 863 (rmail-only-expunge)) 864 (rmail-update-summary) 865 (save-excursion 866 (set-buffer rmail-buffer) 867 (save-buffer)) 868 (set-buffer-modified-p nil)) 869 870(defun rmail-summary-get-new-mail () 871 "Get new mail and recompute summary headers." 872 (interactive) 873 (let (msg) 874 (save-excursion 875 (set-buffer rmail-buffer) 876 (rmail-get-new-mail) 877 ;; Get the proper new message number. 878 (setq msg rmail-current-message)) 879 ;; Make sure that message is displayed. 880 (rmail-summary-goto-msg msg))) 881 882(defun rmail-summary-input (filename) 883 "Run Rmail on file FILENAME." 884 (interactive "FRun rmail on RMAIL file: ") 885 ;; We switch windows here, then display the other Rmail file there. 886 (pop-to-buffer rmail-buffer) 887 (rmail filename)) 888 889(defun rmail-summary-first-message () 890 "Show first message in Rmail file from summary buffer." 891 (interactive) 892 (beginning-of-buffer)) 893 894(defun rmail-summary-last-message () 895 "Show last message in Rmail file from summary buffer." 896 (interactive) 897 (end-of-buffer) 898 (forward-line -1)) 899 900(defvar rmail-summary-edit-map nil) 901(if rmail-summary-edit-map 902 nil 903 (setq rmail-summary-edit-map 904 (nconc (make-sparse-keymap) text-mode-map)) 905 (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit) 906 (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit)) 907 908(defun rmail-summary-edit-current-message () 909 "Edit the contents of this message." 910 (interactive) 911 (pop-to-buffer rmail-buffer) 912 (rmail-edit-current-message) 913 (use-local-map rmail-summary-edit-map)) 914 915(defun rmail-summary-cease-edit () 916 "Finish editing message, then go back to Rmail summary buffer." 917 (interactive) 918 (rmail-cease-edit) 919 (pop-to-buffer rmail-summary-buffer)) 920 921(defun rmail-summary-abort-edit () 922 "Abort edit of current message; restore original contents. 923Go back to summary buffer." 924 (interactive) 925 (rmail-abort-edit) 926 (pop-to-buffer rmail-summary-buffer)) 927 928(defun rmail-summary-search-backward (regexp &optional n) 929 "Show message containing next match for REGEXP. 930Prefix argument gives repeat count; negative argument means search 931backwards (through earlier messages). 932Interactively, empty argument means use same regexp used last time." 933 (interactive 934 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0)) 935 (prompt 936 (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) 937 regexp) 938 (if rmail-search-last-regexp 939 (setq prompt (concat prompt 940 "(default " 941 rmail-search-last-regexp 942 ") "))) 943 (setq regexp (read-string prompt)) 944 (cond ((not (equal regexp "")) 945 (setq rmail-search-last-regexp regexp)) 946 ((not rmail-search-last-regexp) 947 (error "No previous Rmail search string"))) 948 (list rmail-search-last-regexp 949 (prefix-numeric-value current-prefix-arg)))) 950 ;; Don't use save-excursion because that prevents point from moving 951 ;; properly in the summary buffer. 952 (let ((buffer (current-buffer))) 953 (unwind-protect 954 (progn 955 (set-buffer rmail-buffer) 956 (rmail-search regexp (- n))) 957 (set-buffer buffer)))) 958 959(defun rmail-summary-search (regexp &optional n) 960 "Show message containing next match for REGEXP. 961Prefix argument gives repeat count; negative argument means search 962backwards (through earlier messages). 963Interactively, empty argument means use same regexp used last time." 964 (interactive 965 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0)) 966 (prompt 967 (concat (if reversep "Reverse " "") "Rmail search (regexp): ")) 968 regexp) 969 (if rmail-search-last-regexp 970 (setq prompt (concat prompt 971 "(default " 972 rmail-search-last-regexp 973 ") "))) 974 (setq regexp (read-string prompt)) 975 (cond ((not (equal regexp "")) 976 (setq rmail-search-last-regexp regexp)) 977 ((not rmail-search-last-regexp) 978 (error "No previous Rmail search string"))) 979 (list rmail-search-last-regexp 980 (prefix-numeric-value current-prefix-arg)))) 981 ;; Don't use save-excursion because that prevents point from moving 982 ;; properly in the summary buffer. 983 (let ((buffer (current-buffer))) 984 (unwind-protect 985 (progn 986 (set-buffer rmail-buffer) 987 (rmail-search regexp n)) 988 (set-buffer buffer)))) 989 990(defun rmail-summary-toggle-header () 991 "Show original message header if pruned header currently shown, or vice versa." 992 (interactive) 993 (save-excursion 994 (set-buffer rmail-buffer) 995 (rmail-toggle-header))) 996 997(defun rmail-summary-add-label (label) 998 "Add LABEL to labels associated with current Rmail message. 999Completion is performed over known labels when reading." 1000 (interactive (list (save-excursion 1001 (set-buffer rmail-buffer) 1002 (rmail-read-label "Add label")))) 1003 (save-excursion 1004 (set-buffer rmail-buffer) 1005 (rmail-add-label label))) 1006 1007(defun rmail-summary-kill-label (label) 1008 "Remove LABEL from labels associated with current Rmail message. 1009Completion is performed over known labels when reading." 1010 (interactive (list (save-excursion 1011 (set-buffer rmail-buffer) 1012 (rmail-read-label "Kill label")))) 1013 (save-excursion 1014 (set-buffer rmail-buffer) 1015 (rmail-set-label label nil))) 1016 1017;;;; *** Rmail Summary Mailing Commands *** 1018 1019(defun rmail-summary-mail () 1020 "Send mail in another window. 1021While composing the message, use \\[mail-yank-original] to yank the 1022original message into it." 1023 (interactive) 1024 (rmail-start-mail nil nil nil nil nil rmail-buffer) 1025 (use-local-map (copy-keymap (current-local-map))) 1026 (define-key (current-local-map) 1027 "\C-c\C-c" 'rmail-summary-send-and-exit)) 1028 1029(defun rmail-summary-continue () 1030 "Continue composing outgoing message previously being composed." 1031 (interactive) 1032 (rmail-start-mail t)) 1033 1034(defun rmail-summary-reply (just-sender) 1035 "Reply to the current message. 1036Normally include CC: to all other recipients of original message; 1037prefix argument means ignore them. While composing the reply, 1038use \\[mail-yank-original] to yank the original message into it." 1039 (interactive "P") 1040 (set-buffer rmail-buffer) 1041 (rmail-reply just-sender) 1042 (use-local-map (copy-keymap (current-local-map))) 1043 (define-key (current-local-map) 1044 "\C-c\C-c" 'rmail-summary-send-and-exit)) 1045 1046(defun rmail-summary-retry-failure () 1047 "Edit a mail message which is based on the contents of the current message. 1048For a message rejected by the mail system, extract the interesting headers and 1049the body of the original message; otherwise copy the current message." 1050 (interactive) 1051 (set-buffer rmail-buffer) 1052 (rmail-retry-failure) 1053 (use-local-map (copy-keymap (current-local-map))) 1054 (define-key (current-local-map) 1055 "\C-c\C-c" 'rmail-summary-send-and-exit)) 1056 1057(defun rmail-summary-send-and-exit () 1058 "Send mail reply and return to summary buffer." 1059 (interactive) 1060 (mail-send-and-exit t)) 1061 1062(defun rmail-summary-forward (resend) 1063 "Forward the current message to another user. 1064With prefix argument, \"resend\" the message instead of forwarding it; 1065see the documentation of `rmail-resend'." 1066 (interactive "P") 1067 (save-excursion 1068 (set-buffer rmail-buffer) 1069 (rmail-forward resend) 1070 (use-local-map (copy-keymap (current-local-map))) 1071 (define-key (current-local-map) 1072 "\C-c\C-c" 'rmail-summary-send-and-exit))) 1073 1074;; Summary output commands. 1075 1076(defun rmail-summary-output-to-rmail-file () 1077 "Append the current message to an Rmail file named FILE-NAME. 1078If the file does not exist, ask if it should be created. 1079If file is being visited, the message is appended to the Emacs 1080buffer visiting that file." 1081 (interactive) 1082 (save-excursion 1083 (set-buffer rmail-buffer) 1084 (let ((rmail-delete-after-output nil)) 1085 (call-interactively 'rmail-output-to-rmail-file))) 1086 (if rmail-delete-after-output 1087 (rmail-summary-delete-forward nil))) 1088 1089(defun rmail-summary-output () 1090 "Append this message to Unix mail file named FILE-NAME." 1091 (interactive) 1092 (save-excursion 1093 (set-buffer rmail-buffer) 1094 (let ((rmail-delete-after-output nil)) 1095 (call-interactively 'rmail-output))) 1096 (if rmail-delete-after-output 1097 (rmail-summary-delete-forward nil))) 1098 1099;; Sorting messages in Rmail Summary buffer. 1100 1101(defun rmail-summary-sort-by-date (reverse) 1102 "Sort messages of current Rmail summary by date. 1103If prefix argument REVERSE is non-nil, sort them in reverse order." 1104 (interactive "P") 1105 (rmail-sort-from-summary (function rmail-sort-by-date) reverse)) 1106 1107(defun rmail-summary-sort-by-subject (reverse) 1108 "Sort messages of current Rmail summary by subject. 1109If prefix argument REVERSE is non-nil, sort them in reverse order." 1110 (interactive "P") 1111 (rmail-sort-from-summary (function rmail-sort-by-subject) reverse)) 1112 1113(defun rmail-summary-sort-by-author (reverse) 1114 "Sort messages of current Rmail summary by author. 1115If prefix argument REVERSE is non-nil, sort them in reverse order." 1116 (interactive "P") 1117 (rmail-sort-from-summary (function rmail-sort-by-author) reverse)) 1118 1119(defun rmail-summary-sort-by-recipient (reverse) 1120 "Sort messages of current Rmail summary by recipient. 1121If prefix argument REVERSE is non-nil, sort them in reverse order." 1122 (interactive "P") 1123 (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse)) 1124 1125(defun rmail-summary-sort-by-correspondent (reverse) 1126 "Sort messages of current Rmail summary by other correspondent. 1127If prefix argument REVERSE is non-nil, sort them in reverse order." 1128 (interactive "P") 1129 (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse)) 1130 1131(defun rmail-summary-sort-by-lines (reverse) 1132 "Sort messages of current Rmail summary by lines of the message. 1133If prefix argument REVERSE is non-nil, sort them in reverse order." 1134 (interactive "P") 1135 (rmail-sort-from-summary (function rmail-sort-by-lines) reverse)) 1136 1137(defun rmail-summary-sort-by-keywords (reverse labels) 1138 "Sort messages of current Rmail summary by keywords. 1139If prefix argument REVERSE is non-nil, sort them in reverse order. 1140KEYWORDS is a comma-separated list of labels." 1141 (interactive "P\nsSort by labels: ") 1142 (rmail-sort-from-summary 1143 (function (lambda (reverse) 1144 (rmail-sort-by-keywords reverse labels))) 1145 reverse)) 1146 1147(defun rmail-sort-from-summary (sortfun reverse) 1148 "Sort Rmail messages from Summary buffer and update it after sorting." 1149 (require 'rmailsort) 1150 (let ((selwin (selected-window))) 1151 (unwind-protect 1152 (progn (pop-to-buffer rmail-buffer) 1153 (funcall sortfun reverse)) 1154 (select-window selwin)))) 1155 1156;;; rmailsum.el ends here 1157