Return to rmailsum.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

Annotation of GNUtools/emacs/lisp/rmailsum.el, revision 1.1

1.1     ! root        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-new-summary (description function &rest args)
        !            63:   "Create a summary of selected messages.
        !            64: DESCRIPTION makes part of the mode line of the summary buffer.
        !            65: For each message, FUNCTION is applied to the message number and ARGS...
        !            66: and if the result is non-nil, that message is included.
        !            67: nil for FUNCTION means all messages."
        !            68:   (message "Computing summary lines...")
        !            69:   (or (and rmail-summary-buffer
        !            70:           (buffer-name rmail-summary-buffer))
        !            71:       (setq rmail-summary-buffer
        !            72:            (generate-new-buffer (concat (buffer-name) "-summary"))))
        !            73:   (let ((summary-msgs ())
        !            74:        (new-summary-line-count 0))
        !            75:     (let ((msgnum 1)
        !            76:          (buffer-read-only nil))
        !            77:       (save-restriction
        !            78:        (save-excursion
        !            79:          (widen)
        !            80:          (goto-char (point-min))
        !            81:          (while (>= rmail-total-messages msgnum)
        !            82:            (if (or (null function)
        !            83:                    (apply function (cons msgnum args)))
        !            84:                (setq summary-msgs
        !            85:                      (cons (rmail-make-summary-line msgnum)
        !            86:                            summary-msgs)))
        !            87:            (setq msgnum (1+ msgnum))))))
        !            88:     (let ((sbuf rmail-summary-buffer)
        !            89:          (rbuf (current-buffer))
        !            90:          (total rmail-total-messages)
        !            91:          (mesg rmail-current-message))
        !            92:       (pop-to-buffer sbuf)
        !            93:       (let ((buffer-read-only nil))
        !            94:        (erase-buffer)
        !            95:        (cond (summary-msgs
        !            96:               (princ (nreverse summary-msgs) sbuf)
        !            97:               (delete-char -1)
        !            98:               (subst-char-in-region 1 2 ?\( ?\ ))))
        !            99:       (setq buffer-read-only t)
        !           100:       (goto-char (point-min))
        !           101:       (rmail-summary-mode)
        !           102:       (make-local-variable 'minor-mode-alist)
        !           103:       (setq minor-mode-alist (list ": " description))
        !           104:       (setq rmail-buffer rbuf
        !           105:            rmail-total-messages total)
        !           106:       (rmail-summary-goto-msg mesg t)))
        !           107:   (message "Computing summary lines...done"))
        !           108: 
        !           109: (defun rmail-make-summary-line (msg)
        !           110:   (let ((line (or (aref rmail-summary-vector (1- msg))
        !           111:                  (progn
        !           112:                    (setq new-summary-line-count
        !           113:                          (1+ new-summary-line-count))
        !           114:                    (if (zerop (% new-summary-line-count 10))
        !           115:                        (message "Computing summary lines...%d"
        !           116:                                 new-summary-line-count))
        !           117:                    (rmail-make-summary-line-1 msg)))))
        !           118:     ;; Fix up the part of the summary that says "deleted" or "unseen".
        !           119:     (aset line 4
        !           120:          (if (rmail-message-deleted-p msg) ?\D
        !           121:            (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg))))
        !           122:                ?\- ?\ )))
        !           123:     line))
        !           124: 
        !           125: (defun rmail-make-summary-line-1 (msg)
        !           126:   (goto-char (rmail-msgbeg msg))
        !           127:   (let* ((lim (save-excursion (forward-line 2) (point)))
        !           128:         pos
        !           129:         (labels
        !           130:          (progn
        !           131:            (forward-char 3)
        !           132:            (concat
        !           133: ;           (if (save-excursion (re-search-forward ",answered," lim t))
        !           134: ;               "*" "")
        !           135: ;           (if (save-excursion (re-search-forward ",filed," lim t))
        !           136: ;               "!" "")
        !           137:             (if (progn (search-forward ",,") (eolp))
        !           138:                 ""
        !           139:               (concat "{"
        !           140:                       (buffer-substring (point)
        !           141:                                         (progn (end-of-line) (point)))
        !           142:                       "} ")))))
        !           143:         (line
        !           144:          (progn
        !           145:            (forward-line 1)
        !           146:            (if (looking-at "Summary-line: ")
        !           147:                (progn
        !           148:                  (goto-char (match-end 0))
        !           149:                  (setq line
        !           150:                        (buffer-substring (point)
        !           151:                                          (progn (forward-line 1) (point)))))))))
        !           152:     ;; Obsolete status lines lacking a # should be flushed.
        !           153:     (and line
        !           154:         (not (string-match "#" line))
        !           155:         (progn
        !           156:           (delete-region (point)
        !           157:                          (progn (forward-line -1) (point)))
        !           158:           (setq line nil)))
        !           159:     ;; If we didn't get a valid status line from the message,
        !           160:     ;; make a new one and put it in the message.
        !           161:     (or line
        !           162:        (let* ((case-fold-search t)
        !           163:               (next (rmail-msgend msg))
        !           164:               (beg (if (progn (goto-char (rmail-msgbeg msg))
        !           165:                               (search-forward "\n*** EOOH ***\n" next t))
        !           166:                        (point)
        !           167:                      (forward-line 1)
        !           168:                      (point)))
        !           169:               (end (progn (search-forward "\n\n" nil t) (point))))
        !           170:          (save-restriction
        !           171:            (narrow-to-region beg end)
        !           172:            (goto-char beg)
        !           173:            (setq line (rmail-make-basic-summary-line)))
        !           174:          (goto-char (rmail-msgbeg msg))
        !           175:          (forward-line 2)
        !           176:          (insert "Summary-line: " line)))
        !           177:     (setq pos (string-match "#" line))
        !           178:     (aset rmail-summary-vector (1- msg)
        !           179:          (concat (format "%4d  " msg)
        !           180:                  (substring line 0 pos)
        !           181:                  labels
        !           182:                  (substring line (1+ pos))))))
        !           183: 
        !           184: (defun rmail-make-basic-summary-line ()
        !           185:   (goto-char (point-min))
        !           186:   (concat (save-excursion
        !           187:            (if (not (re-search-forward "^Date:" nil t))
        !           188:                "      "
        !           189:              (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
        !           190:                      (save-excursion (end-of-line) (point)) t)
        !           191:                     (format "%2d-%3s"
        !           192:                             (string-to-int (buffer-substring
        !           193:                                             (match-beginning 2)
        !           194:                                             (match-end 2)))
        !           195:                             (buffer-substring
        !           196:                              (match-beginning 4) (match-end 4))))
        !           197:                    ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
        !           198:                      (save-excursion (end-of-line) (point)) t)
        !           199:                     (format "%2d-%3s"
        !           200:                             (string-to-int (buffer-substring
        !           201:                                             (match-beginning 4)
        !           202:                                             (match-end 4)))
        !           203:                             (buffer-substring
        !           204:                              (match-beginning 2) (match-end 2))))
        !           205:                    (t "??????"))))
        !           206:          "  "
        !           207:          (save-excursion
        !           208:            (if (not (re-search-forward "^From:[ \t]*" nil t))
        !           209:                "                         "
        !           210:              (let* ((from (mail-strip-quoted-names
        !           211:                            (buffer-substring
        !           212:                             (1- (point))
        !           213:                             (progn (end-of-line)
        !           214:                                    (skip-chars-backward " \t")
        !           215:                                    (point)))))
        !           216:                     len mch lo)
        !           217:                (if (string-match (concat "^"
        !           218:                                          (regexp-quote (user-login-name))
        !           219:                                          "\\($\\|@\\)")
        !           220:                                  from)
        !           221:                    (save-excursion
        !           222:                      (goto-char (point-min))
        !           223:                      (if (not (re-search-forward "^To:[ \t]*" nil t))
        !           224:                          nil
        !           225:                        (setq from
        !           226:                              (concat "to: "
        !           227:                                      (mail-strip-quoted-names
        !           228:                                       (buffer-substring
        !           229:                                        (point)
        !           230:                                        (progn (end-of-line)
        !           231:                                               (skip-chars-backward " \t")
        !           232:                                               (point)))))))))
        !           233:                (setq len (length from))
        !           234:                (setq mch (string-match "[@%]" from))
        !           235:                (format "%25s"
        !           236:                        (if (or (not mch) (<= len 25))
        !           237:                            (substring from (max 0 (- len 25)))
        !           238:                          (substring from
        !           239:                                     (setq lo (cond ((< (- mch 9) 0) 0)
        !           240:                                                    ((< len (+ mch 16))
        !           241:                                                     (- len 25))
        !           242:                                                    (t (- mch 9))))
        !           243:                                     (min len (+ lo 25))))))))
        !           244:          "  #"
        !           245:          (if (re-search-forward "^Subject:" nil t)
        !           246:              (progn (skip-chars-forward " \t")
        !           247:                     (buffer-substring (point)
        !           248:                                       (progn (end-of-line)
        !           249:                                              (point))))
        !           250:            (re-search-forward "[\n][\n]+" nil t)
        !           251:            (buffer-substring (point) (progn (end-of-line) (point))))
        !           252:          "\n"))
        !           253: 
        !           254: (defun rmail-summary-next-all (&optional number)
        !           255:   (interactive "p")
        !           256:   (forward-line (if number number 1))
        !           257:   (rmail-summary-goto-msg))
        !           258: 
        !           259: (defun rmail-summary-previous-all (&optional number)
        !           260:   (interactive "p")
        !           261:   (forward-line (- (if number number 1)))
        !           262:   (rmail-summary-goto-msg))
        !           263: 
        !           264: (defun rmail-summary-next-msg (&optional number)
        !           265:   (interactive "p")
        !           266:   (forward-line 0)
        !           267:   (and (> number 0) (forward-line 1))
        !           268:   (let ((count (if (< number 0) (- number) number))
        !           269:        (search (if (> number 0) 're-search-forward 're-search-backward))
        !           270:        end)
        !           271:     (while (and (> count 0) (funcall search "^.....[^D]" nil t))
        !           272:       (setq count (1- count)))
        !           273:     (rmail-summary-goto-msg)))
        !           274: 
        !           275: (defun rmail-summary-previous-msg (&optional number)
        !           276:   (interactive "p")
        !           277:   (rmail-summary-next-msg (- (if number number 1))))
        !           278: 
        !           279: (defun rmail-summary-delete-forward ()
        !           280:   (interactive)
        !           281:   (let (end)
        !           282:     (rmail-summary-goto-msg)
        !           283:     (pop-to-buffer rmail-buffer)
        !           284:     (rmail-delete-message)
        !           285:     (pop-to-buffer rmail-summary-buffer)
        !           286:     (let ((buffer-read-only nil))
        !           287:       (skip-chars-forward " ")
        !           288:       (skip-chars-forward "[0-9]")
        !           289:       (delete-char 1)
        !           290:       (insert "D"))
        !           291:     (rmail-summary-next-msg 1)))
        !           292: 
        !           293: (defun rmail-summary-undelete ()
        !           294:   (interactive)
        !           295:   (let ((buffer-read-only nil))
        !           296:     (end-of-line)
        !           297:     (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
        !           298:           (replace-match "\\1 ")
        !           299:           (rmail-summary-goto-msg)
        !           300:           (pop-to-buffer rmail-buffer)
        !           301:           (and (rmail-message-deleted-p rmail-current-message)
        !           302:                (rmail-undelete-previous-message))
        !           303:           (pop-to-buffer rmail-summary-buffer))
        !           304:          (t
        !           305:           (rmail-summary-goto-msg)))))
        !           306: 
        !           307: ;; Rmail Summary mode is suitable only for specially formatted data.
        !           308: (put 'rmail-summary-mode 'mode-class 'special)
        !           309: 
        !           310: (defun rmail-summary-mode ()
        !           311:   "Major mode in effect in Rmail summary buffer.
        !           312: A subset of the Rmail mode commands are supported in this mode. 
        !           313: As commands are issued in the summary buffer the corresponding
        !           314: mail message is displayed in the rmail buffer.
        !           315: 
        !           316: n       Move to next undeleted message, or arg messages.
        !           317: p       Move to previous undeleted message, or arg messages.
        !           318: C-n    Move to next, or forward arg messages.
        !           319: C-p    Move to previous, or previous arg messages.
        !           320: j       Jump to the message at the cursor location.
        !           321: d       Delete the message at the cursor location and move to next message.
        !           322: u      Undelete this or previous deleted message.
        !           323: q      Quit Rmail.
        !           324: x      Exit and kill the summary window.
        !           325: space   Scroll message in other window forward.
        !           326: delete  Scroll message backward.
        !           327: 
        !           328: Entering this mode calls value of hook variable rmail-summary-mode-hook."
        !           329:   (interactive)
        !           330:   (kill-all-local-variables)
        !           331:   (make-local-variable 'rmail-buffer)
        !           332:   (make-local-variable 'rmail-total-messages)
        !           333:   (setq major-mode 'rmail-summary-mode)
        !           334:   (setq mode-name "RMAIL Summary")
        !           335:   (use-local-map rmail-summary-mode-map)
        !           336:   (setq truncate-lines t)
        !           337:   (setq buffer-read-only t)
        !           338:   (set-syntax-table text-mode-syntax-table)
        !           339:   (run-hooks 'rmail-summary-mode-hook))
        !           340: 
        !           341: (defun rmail-summary-goto-msg (&optional n nowarn)
        !           342:   (interactive "P")
        !           343:   (if (consp n) (setq n (prefix-numeric-value n)))
        !           344:   (if (eobp) (forward-line -1))
        !           345:   (beginning-of-line)
        !           346:   (let ((buf rmail-buffer)
        !           347:        (cur (point))
        !           348:        (curmsg (string-to-int
        !           349:                 (buffer-substring (point)
        !           350:                                   (min (point-max) (+ 5 (point)))))))
        !           351:     (if (not n)
        !           352:        (setq n curmsg)
        !           353:       (if (< n 1)
        !           354:          (progn (message "No preceding message")
        !           355:                 (setq n 1)))
        !           356:       (if (> n rmail-total-messages)
        !           357:          (progn (message "No following message")
        !           358:                 (goto-char (point-max))
        !           359:                 (rmail-summary-goto-msg)))
        !           360:       (goto-char (point-min))
        !           361:       (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
        !           362:          (progn (or nowarn (message "Message %d not found" n))
        !           363:                 (setq n curmsg)
        !           364:                 (goto-char cur))))
        !           365:     (beginning-of-line)
        !           366:     (skip-chars-forward " ")
        !           367:     (skip-chars-forward "0-9")
        !           368:     (save-excursion (if (= (following-char) ?-)
        !           369:                        (let ((buffer-read-only nil))
        !           370:                          (delete-char 1)
        !           371:                          (insert " "))))
        !           372:     (beginning-of-line)
        !           373:     (pop-to-buffer buf)
        !           374:     (rmail-show-message n)
        !           375:     (pop-to-buffer rmail-summary-buffer)))
        !           376: 
        !           377: (defvar rmail-summary-mode-map nil)
        !           378: 
        !           379: (if rmail-summary-mode-map
        !           380:     nil
        !           381:   (setq rmail-summary-mode-map (make-keymap))
        !           382:   (suppress-keymap rmail-summary-mode-map)
        !           383:   (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
        !           384:   (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
        !           385:   (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
        !           386:   (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all)
        !           387:   (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all)
        !           388:   (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
        !           389:   (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
        !           390:   (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
        !           391:   (define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
        !           392:   (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
        !           393:   (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward))
        !           394: 
        !           395: (defun rmail-summary-scroll-msg-up (&optional dist)
        !           396:   "Scroll other window forward."
        !           397:   (interactive "P")
        !           398:   (let ((window (selected-window))
        !           399:        (new-window (display-buffer rmail-buffer)))
        !           400:     (unwind-protect
        !           401:        (progn
        !           402:          (select-window new-window)
        !           403:          (scroll-up dist))
        !           404:       (select-window window))))
        !           405: 
        !           406: (defun rmail-summary-scroll-msg-down (&optional dist)
        !           407:   "Scroll other window backward."
        !           408:   (interactive "P")
        !           409:   (let ((window (selected-window))
        !           410:        (new-window (display-buffer rmail-buffer)))
        !           411:     (unwind-protect
        !           412:        (progn
        !           413:          (select-window new-window)
        !           414:          (scroll-down dist))
        !           415:       (select-window window))))
        !           416: 
        !           417: (defun rmail-summary-quit ()
        !           418:   "Quit out of rmail and rmail summary."
        !           419:   (interactive)
        !           420:   (rmail-summary-exit)
        !           421:   (rmail-quit))
        !           422: 
        !           423: (defun rmail-summary-exit ()
        !           424:   "Exit rmail summary, remaining within rmail."
        !           425:   (interactive)
        !           426:   (bury-buffer (current-buffer))
        !           427:   (if (get-buffer-window rmail-buffer)
        !           428:       ;; Select the window with rmail in it, then delete this window.
        !           429:       (select-window (prog1
        !           430:                         (get-buffer-window rmail-buffer)
        !           431:                       (delete-window (selected-window))))
        !           432:     ;; Switch to the rmail buffer in this window.
        !           433:     (switch-to-buffer rmail-buffer)))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.