Mercurial > emacs
comparison lisp/mail/rmailsum.el @ 130:ad8219ab7a97
Initial revision
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Fri, 30 Nov 1990 22:29:57 +0000 |
| parents | |
| children | 7cbd4fcd8b0f |
comparison
equal
deleted
inserted
replaced
| 129:9e96238c8d27 | 130:ad8219ab7a97 |
|---|---|
| 1 ;; "RMAIL" mail reader for Emacs. | |
| 2 ;; Copyright (C) 1985 Free Software Foundation, Inc. | |
| 3 | |
| 4 ;; This file is part of GNU Emacs. | |
| 5 | |
| 6 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 7 ;; it under the terms of the GNU General Public License as published by | |
| 8 ;; the Free Software Foundation; either version 1, or (at your option) | |
| 9 ;; any later version. | |
| 10 | |
| 11 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 14 ;; GNU General Public License for more details. | |
| 15 | |
| 16 ;; You should have received a copy of the GNU General Public License | |
| 17 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
| 18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 19 | |
| 20 | |
| 21 ;; summary things | |
| 22 | |
| 23 (defun rmail-summary () | |
| 24 "Display a summary of all messages, one line per message." | |
| 25 (interactive) | |
| 26 (rmail-new-summary "All" nil)) | |
| 27 | |
| 28 (defun rmail-summary-by-labels (labels) | |
| 29 "Display a summary of all messages with one or more LABELS. | |
| 30 LABELS should be a string containing the desired labels, separated by commas." | |
| 31 (interactive "sLabels to summarize by: ") | |
| 32 (if (string= labels "") | |
| 33 (setq labels (or rmail-last-multi-labels | |
| 34 (error "No label specified")))) | |
| 35 (setq rmail-last-multi-labels labels) | |
| 36 (rmail-new-summary (concat "labels " labels) | |
| 37 'rmail-message-labels-p | |
| 38 (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) | |
| 39 | |
| 40 (defun rmail-summary-by-recipients (recipients &optional primary-only) | |
| 41 "Display a summary of all messages with the given RECIPIENTS. | |
| 42 Normally checks the To, From and Cc fields of headers; | |
| 43 but if PRIMARY-ONLY is non-nil (prefix arg given), | |
| 44 only look in the To and From fields. | |
| 45 RECIPIENTS is a string of names separated by commas." | |
| 46 (interactive "sRecipients to summarize by: \nP") | |
| 47 (rmail-new-summary | |
| 48 (concat "recipients " recipients) | |
| 49 'rmail-message-recipients-p | |
| 50 (mail-comma-list-regexp recipients) primary-only)) | |
| 51 | |
| 52 (defun rmail-message-recipients-p (msg recipients &optional primary-only) | |
| 53 (save-restriction | |
| 54 (goto-char (rmail-msgbeg msg)) | |
| 55 (search-forward "\n*** EOOH ***\n") | |
| 56 (narrow-to-region (point) (progn (search-forward "\n\n") (point))) | |
| 57 (or (string-match recipients (or (mail-fetch-field "To") "")) | |
| 58 (string-match recipients (or (mail-fetch-field "From") "")) | |
| 59 (if (not primary-only) | |
| 60 (string-match recipients (or (mail-fetch-field "Cc") "")))))) | |
| 61 | |
| 62 (defun rmail-summary-by-regexp (regexp) | |
| 63 "Display a summary of all messages according to regexp REGEXP. | |
| 64 If the regular expression is found in the header of the message | |
| 65 \(including in the date and other lines, as well as the subject line), | |
| 66 Emacs will list the header line in the RMAIL-summary." | |
| 67 (interactive "sRegexp to summarize by: ") | |
| 68 (if (string= regexp "") | |
| 69 (setq regexp (or rmail-last-regexp | |
| 70 (error "No regexp specified")))) | |
| 71 (setq rmail-last-regexp regexp) | |
| 72 (rmail-new-summary (concat "regexp " regexp) | |
| 73 'rmail-message-regexp-p | |
| 74 regexp)) | |
| 75 | |
| 76 (defun rmail-message-regexp-p (msg regexp) | |
| 77 "Return t, if for message number MSG, regexp REGEXP matches in the header." | |
| 78 (goto-char (rmail-msgbeg msg)) | |
| 79 (let ((end | |
| 80 (save-excursion | |
| 81 (search-forward "*** EOOH ***" (point-max)) (point)))) | |
| 82 (re-search-forward regexp end t))) | |
| 83 | |
| 84 (defun rmail-new-summary (description function &rest args) | |
| 85 "Create a summary of selected messages. | |
| 86 DESCRIPTION makes part of the mode line of the summary buffer. | |
| 87 For each message, FUNCTION is applied to the message number and ARGS... | |
| 88 and if the result is non-nil, that message is included. | |
| 89 nil for FUNCTION means all messages." | |
| 90 (message "Computing summary lines...") | |
| 91 (or (and rmail-summary-buffer | |
| 92 (buffer-name rmail-summary-buffer)) | |
| 93 (setq rmail-summary-buffer | |
| 94 (generate-new-buffer (concat (buffer-name) "-summary")))) | |
| 95 (let ((summary-msgs ()) | |
| 96 (new-summary-line-count 0)) | |
| 97 (let ((msgnum 1) | |
| 98 (buffer-read-only nil)) | |
| 99 (save-restriction | |
| 100 (save-excursion | |
| 101 (widen) | |
| 102 (goto-char (point-min)) | |
| 103 (while (>= rmail-total-messages msgnum) | |
| 104 (if (or (null function) | |
| 105 (apply function (cons msgnum args))) | |
| 106 (setq summary-msgs | |
| 107 (cons (rmail-make-summary-line msgnum) | |
| 108 summary-msgs))) | |
| 109 (setq msgnum (1+ msgnum)))))) | |
| 110 (let ((sbuf rmail-summary-buffer) | |
| 111 (rbuf (current-buffer)) | |
| 112 (total rmail-total-messages) | |
| 113 (mesg rmail-current-message)) | |
| 114 (pop-to-buffer sbuf) | |
| 115 ;; Our scroll command should always scroll the Rmail buffer. | |
| 116 (make-local-variable 'other-window-scroll-buffer) | |
| 117 (setq other-window-scroll-buffer rbuf) | |
| 118 (let ((buffer-read-only nil)) | |
| 119 (erase-buffer) | |
| 120 (cond (summary-msgs | |
| 121 (princ (nreverse summary-msgs) sbuf) | |
| 122 (delete-char -1) | |
| 123 (subst-char-in-region 1 2 ?\( ?\ )))) | |
| 124 (setq buffer-read-only t) | |
| 125 (goto-char (point-min)) | |
| 126 (rmail-summary-mode) | |
| 127 (make-local-variable 'minor-mode-alist) | |
| 128 (setq minor-mode-alist (list ": " description)) | |
| 129 (setq rmail-buffer rbuf | |
| 130 rmail-total-messages total) | |
| 131 (rmail-summary-goto-msg mesg t))) | |
| 132 (message "Computing summary lines...done")) | |
| 133 | |
| 134 (defun rmail-make-summary-line (msg) | |
| 135 (let ((line (or (aref rmail-summary-vector (1- msg)) | |
| 136 (progn | |
| 137 (setq new-summary-line-count | |
| 138 (1+ new-summary-line-count)) | |
| 139 (if (zerop (% new-summary-line-count 10)) | |
| 140 (message "Computing summary lines...%d" | |
| 141 new-summary-line-count)) | |
| 142 (rmail-make-summary-line-1 msg))))) | |
| 143 ;; Fix up the part of the summary that says "deleted" or "unseen". | |
| 144 (aset line 4 | |
| 145 (if (rmail-message-deleted-p msg) ?\D | |
| 146 (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg)))) | |
| 147 ?\- ?\ ))) | |
| 148 line)) | |
| 149 | |
| 150 (defun rmail-make-summary-line-1 (msg) | |
| 151 (goto-char (rmail-msgbeg msg)) | |
| 152 (let* ((lim (save-excursion (forward-line 2) (point))) | |
| 153 pos | |
| 154 (labels | |
| 155 (progn | |
| 156 (forward-char 3) | |
| 157 (concat | |
| 158 ; (if (save-excursion (re-search-forward ",answered," lim t)) | |
| 159 ; "*" "") | |
| 160 ; (if (save-excursion (re-search-forward ",filed," lim t)) | |
| 161 ; "!" "") | |
| 162 (if (progn (search-forward ",,") (eolp)) | |
| 163 "" | |
| 164 (concat "{" | |
| 165 (buffer-substring (point) | |
| 166 (progn (end-of-line) (point))) | |
| 167 "} "))))) | |
| 168 (line | |
| 169 (progn | |
| 170 (forward-line 1) | |
| 171 (if (looking-at "Summary-line: ") | |
| 172 (progn | |
| 173 (goto-char (match-end 0)) | |
| 174 (setq line | |
| 175 (buffer-substring (point) | |
| 176 (progn (forward-line 1) (point))))))))) | |
| 177 ;; Obsolete status lines lacking a # should be flushed. | |
| 178 (and line | |
| 179 (not (string-match "#" line)) | |
| 180 (progn | |
| 181 (delete-region (point) | |
| 182 (progn (forward-line -1) (point))) | |
| 183 (setq line nil))) | |
| 184 ;; If we didn't get a valid status line from the message, | |
| 185 ;; make a new one and put it in the message. | |
| 186 (or line | |
| 187 (let* ((case-fold-search t) | |
| 188 (next (rmail-msgend msg)) | |
| 189 (beg (if (progn (goto-char (rmail-msgbeg msg)) | |
| 190 (search-forward "\n*** EOOH ***\n" next t)) | |
| 191 (point) | |
| 192 (forward-line 1) | |
| 193 (point))) | |
| 194 (end (progn (search-forward "\n\n" nil t) (point)))) | |
| 195 (save-restriction | |
| 196 (narrow-to-region beg end) | |
| 197 (goto-char beg) | |
| 198 (setq line (rmail-make-basic-summary-line))) | |
| 199 (goto-char (rmail-msgbeg msg)) | |
| 200 (forward-line 2) | |
| 201 (insert "Summary-line: " line))) | |
| 202 (setq pos (string-match "#" line)) | |
| 203 (aset rmail-summary-vector (1- msg) | |
| 204 (concat (format "%4d " msg) | |
| 205 (substring line 0 pos) | |
| 206 labels | |
| 207 (substring line (1+ pos)))))) | |
| 208 | |
| 209 (defun rmail-make-basic-summary-line () | |
| 210 (goto-char (point-min)) | |
| 211 (concat (save-excursion | |
| 212 (if (not (re-search-forward "^Date:" nil t)) | |
| 213 " " | |
| 214 (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" | |
| 215 (save-excursion (end-of-line) (point)) t) | |
| 216 (format "%2d-%3s" | |
| 217 (string-to-int (buffer-substring | |
| 218 (match-beginning 2) | |
| 219 (match-end 2))) | |
| 220 (buffer-substring | |
| 221 (match-beginning 4) (match-end 4)))) | |
| 222 ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" | |
| 223 (save-excursion (end-of-line) (point)) t) | |
| 224 (format "%2d-%3s" | |
| 225 (string-to-int (buffer-substring | |
| 226 (match-beginning 4) | |
| 227 (match-end 4))) | |
| 228 (buffer-substring | |
| 229 (match-beginning 2) (match-end 2)))) | |
| 230 (t "??????")))) | |
| 231 " " | |
| 232 (save-excursion | |
| 233 (if (not (re-search-forward "^From:[ \t]*" nil t)) | |
| 234 " " | |
| 235 (let* ((from (mail-strip-quoted-names | |
| 236 (buffer-substring | |
| 237 (1- (point)) | |
| 238 (progn (end-of-line) | |
| 239 (skip-chars-backward " \t") | |
| 240 (point))))) | |
| 241 len mch lo) | |
| 242 (if (string-match (concat "^" | |
| 243 (regexp-quote (user-login-name)) | |
| 244 "\\($\\|@\\)") | |
| 245 from) | |
| 246 (save-excursion | |
| 247 (goto-char (point-min)) | |
| 248 (if (not (re-search-forward "^To:[ \t]*" nil t)) | |
| 249 nil | |
| 250 (setq from | |
| 251 (concat "to: " | |
| 252 (mail-strip-quoted-names | |
| 253 (buffer-substring | |
| 254 (point) | |
| 255 (progn (end-of-line) | |
| 256 (skip-chars-backward " \t") | |
| 257 (point))))))))) | |
| 258 (setq len (length from)) | |
| 259 (setq mch (string-match "[@%]" from)) | |
| 260 (format "%25s" | |
| 261 (if (or (not mch) (<= len 25)) | |
| 262 (substring from (max 0 (- len 25))) | |
| 263 (substring from | |
| 264 (setq lo (cond ((< (- mch 9) 0) 0) | |
| 265 ((< len (+ mch 16)) | |
| 266 (- len 25)) | |
| 267 (t (- mch 9)))) | |
| 268 (min len (+ lo 25)))))))) | |
| 269 " #" | |
| 270 (if (re-search-forward "^Subject:" nil t) | |
| 271 (progn (skip-chars-forward " \t") | |
| 272 (buffer-substring (point) | |
| 273 (progn (end-of-line) | |
| 274 (point)))) | |
| 275 (re-search-forward "[\n][\n]+" nil t) | |
| 276 (buffer-substring (point) (progn (end-of-line) (point)))) | |
| 277 "\n")) | |
| 278 | |
| 279 (defun rmail-summary-next-all (&optional number) | |
| 280 (interactive "p") | |
| 281 (forward-line (if number number 1)) | |
| 282 (rmail-summary-goto-msg)) | |
| 283 | |
| 284 (defun rmail-summary-previous-all (&optional number) | |
| 285 (interactive "p") | |
| 286 (forward-line (- (if number number 1))) | |
| 287 (rmail-summary-goto-msg)) | |
| 288 | |
| 289 (defun rmail-summary-next-msg (&optional number) | |
| 290 (interactive "p") | |
| 291 (forward-line 0) | |
| 292 (and (> number 0) (forward-line 1)) | |
| 293 (let ((count (if (< number 0) (- number) number)) | |
| 294 (search (if (> number 0) 're-search-forward 're-search-backward)) | |
| 295 end) | |
| 296 (while (and (> count 0) (funcall search "^.....[^D]" nil t)) | |
| 297 (setq count (1- count))) | |
| 298 (rmail-summary-goto-msg))) | |
| 299 | |
| 300 (defun rmail-summary-previous-msg (&optional number) | |
| 301 (interactive "p") | |
| 302 (rmail-summary-next-msg (- (if number number 1)))) | |
| 303 | |
| 304 (defun rmail-summary-delete-forward () | |
| 305 (interactive) | |
| 306 (let (end) | |
| 307 (rmail-summary-goto-msg) | |
| 308 (pop-to-buffer rmail-buffer) | |
| 309 (rmail-delete-message) | |
| 310 (pop-to-buffer rmail-summary-buffer) | |
| 311 (let ((buffer-read-only nil)) | |
| 312 (skip-chars-forward " ") | |
| 313 (skip-chars-forward "[0-9]") | |
| 314 (delete-char 1) | |
| 315 (insert "D")) | |
| 316 (rmail-summary-next-msg 1))) | |
| 317 | |
| 318 (defun rmail-summary-delete-backward () | |
| 319 (interactive) | |
| 320 (let (end) | |
| 321 (rmail-summary-goto-msg) | |
| 322 (pop-to-buffer rmail-buffer) | |
| 323 (rmail-delete-message) | |
| 324 (pop-to-buffer rmail-summary-buffer) | |
| 325 (let ((buffer-read-only nil)) | |
| 326 (skip-chars-forward " ") | |
| 327 (skip-chars-forward "[0-9]") | |
| 328 (delete-char 1) | |
| 329 (insert "D")) | |
| 330 (rmail-summary-next-msg -1))) | |
| 331 | |
| 332 (defun rmail-summary-undelete () | |
| 333 (interactive) | |
| 334 (let ((buffer-read-only nil)) | |
| 335 (end-of-line) | |
| 336 (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) | |
| 337 (replace-match "\\1 ") | |
| 338 (rmail-summary-goto-msg) | |
| 339 (pop-to-buffer rmail-buffer) | |
| 340 (and (rmail-message-deleted-p rmail-current-message) | |
| 341 (rmail-undelete-previous-message)) | |
| 342 (pop-to-buffer rmail-summary-buffer)) | |
| 343 (t | |
| 344 (rmail-summary-goto-msg))))) | |
| 345 | |
| 346 ;; Rmail Summary mode is suitable only for specially formatted data. | |
| 347 (put 'rmail-summary-mode 'mode-class 'special) | |
| 348 | |
| 349 (defun rmail-summary-mode () | |
| 350 "Major mode in effect in Rmail summary buffer. | |
| 351 A subset of the Rmail mode commands are supported in this mode. | |
| 352 As commands are issued in the summary buffer the corresponding | |
| 353 mail message is displayed in the rmail buffer. | |
| 354 | |
| 355 n Move to next undeleted message, or arg messages. | |
| 356 p Move to previous undeleted message, or arg messages. | |
| 357 M-n Move to next, or forward arg messages. | |
| 358 M-p Move to previous, or previous arg messages. | |
| 359 j Jump to the message at the cursor location. | |
| 360 d Delete the message at the cursor location and move to next message. | |
| 361 C-d Delete the message at the cursor location and move to previous message. | |
| 362 u Undelete this or previous deleted message. | |
| 363 q Quit Rmail. | |
| 364 x Exit and kill the summary window. | |
| 365 space Scroll message in other window forward. | |
| 366 delete Scroll message backward. | |
| 367 | |
| 368 Entering this mode calls value of hook variable rmail-summary-mode-hook." | |
| 369 (interactive) | |
| 370 (kill-all-local-variables) | |
| 371 (make-local-variable 'rmail-buffer) | |
| 372 (make-local-variable 'rmail-total-messages) | |
| 373 (setq major-mode 'rmail-summary-mode) | |
| 374 (setq mode-name "RMAIL Summary") | |
| 375 (use-local-map rmail-summary-mode-map) | |
| 376 (setq truncate-lines t) | |
| 377 (setq buffer-read-only t) | |
| 378 (set-syntax-table text-mode-syntax-table) | |
| 379 (run-hooks 'rmail-summary-mode-hook)) | |
| 380 | |
| 381 (defun rmail-summary-goto-msg (&optional n nowarn) | |
| 382 (interactive "P") | |
| 383 (if (consp n) (setq n (prefix-numeric-value n))) | |
| 384 (if (eobp) (forward-line -1)) | |
| 385 (beginning-of-line) | |
| 386 (let ((buf rmail-buffer) | |
| 387 (cur (point)) | |
| 388 (curmsg (string-to-int | |
| 389 (buffer-substring (point) | |
| 390 (min (point-max) (+ 5 (point))))))) | |
| 391 (if (not n) | |
| 392 (setq n curmsg) | |
| 393 (if (< n 1) | |
| 394 (progn (message "No preceding message") | |
| 395 (setq n 1))) | |
| 396 (if (> n rmail-total-messages) | |
| 397 (progn (message "No following message") | |
| 398 (goto-char (point-max)) | |
| 399 (rmail-summary-goto-msg))) | |
| 400 (goto-char (point-min)) | |
| 401 (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t)) | |
| 402 (progn (or nowarn (message "Message %d not found" n)) | |
| 403 (setq n curmsg) | |
| 404 (goto-char cur)))) | |
| 405 (beginning-of-line) | |
| 406 (skip-chars-forward " ") | |
| 407 (skip-chars-forward "0-9") | |
| 408 (save-excursion (if (= (following-char) ?-) | |
| 409 (let ((buffer-read-only nil)) | |
| 410 (delete-char 1) | |
| 411 (insert " ")))) | |
| 412 (beginning-of-line) | |
| 413 (pop-to-buffer buf) | |
| 414 (rmail-show-message n) | |
| 415 (pop-to-buffer rmail-summary-buffer))) | |
| 416 | |
| 417 (defvar rmail-summary-mode-map nil) | |
| 418 | |
| 419 (if rmail-summary-mode-map | |
| 420 nil | |
| 421 (setq rmail-summary-mode-map (make-keymap)) | |
| 422 (suppress-keymap rmail-summary-mode-map) | |
| 423 (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) | |
| 424 (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) | |
| 425 (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) | |
| 426 (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all) | |
| 427 (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all) | |
| 428 (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) | |
| 429 (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) | |
| 430 (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) | |
| 431 (define-key rmail-summary-mode-map "x" 'rmail-summary-exit) | |
| 432 (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) | |
| 433 (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) | |
| 434 (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward)) | |
| 435 | |
| 436 (defun rmail-summary-scroll-msg-up (&optional dist) | |
| 437 "Scroll other window forward." | |
| 438 (interactive "P") | |
| 439 (let ((window (selected-window)) | |
| 440 (new-window (display-buffer rmail-buffer))) | |
| 441 (unwind-protect | |
| 442 (progn | |
| 443 (select-window new-window) | |
| 444 (scroll-up dist)) | |
| 445 (select-window window)))) | |
| 446 | |
| 447 (defun rmail-summary-scroll-msg-down (&optional dist) | |
| 448 "Scroll other window backward." | |
| 449 (interactive "P") | |
| 450 (let ((window (selected-window)) | |
| 451 (new-window (display-buffer rmail-buffer))) | |
| 452 (unwind-protect | |
| 453 (progn | |
| 454 (select-window new-window) | |
| 455 (scroll-down dist)) | |
| 456 (select-window window)))) | |
| 457 | |
| 458 (defun rmail-summary-quit () | |
| 459 "Quit out of rmail and rmail summary." | |
| 460 (interactive) | |
| 461 (rmail-summary-exit) | |
| 462 (rmail-quit)) | |
| 463 | |
| 464 (defun rmail-summary-exit () | |
| 465 "Exit rmail summary, remaining within rmail." | |
| 466 (interactive) | |
| 467 (bury-buffer (current-buffer)) | |
| 468 (if (get-buffer-window rmail-buffer) | |
| 469 ;; Select the window with rmail in it, then delete this window. | |
| 470 (select-window (prog1 | |
| 471 (get-buffer-window rmail-buffer) | |
| 472 (delete-window (selected-window)))) | |
| 473 ;; Switch to the rmail buffer in this window. | |
| 474 (switch-to-buffer rmail-buffer))) |