Return to rmailsum.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/rmailsum.el, revision 1.1

1.1     ! root        1: ;; "RMAIL" mail reader for Emacs.
        !             2: ;; Copyright (C) 1985 Richard M. Stallman.
        !             3: 
        !             4: ;; This file is part of GNU Emacs.
        !             5: 
        !             6: ;; GNU Emacs is distributed in the hope that it will be useful,
        !             7: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: ;; accepts responsibility to anyone for the consequences of using it
        !             9: ;; or for whether it serves any particular purpose or works at all,
        !            10: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: ;; License for full details.
        !            12: 
        !            13: ;; Everyone is granted permission to copy, modify and redistribute
        !            14: ;; GNU Emacs, but only under the conditions described in the
        !            15: ;; GNU Emacs General Public License.   A copy of this license is
        !            16: ;; supposed to have been given to you along with GNU Emacs so you
        !            17: ;; can know your rights and responsibilities.  It should be in a
        !            18: ;; file named COPYING.  Among other things, the copyright notice
        !            19: ;; and this notice must be preserved on all copies.
        !            20: 
        !            21: 
        !            22: ;; summary things
        !            23: 
        !            24: (defun rmail-summary ()
        !            25:   "Display a summary of all messages, one line per message."
        !            26:   (interactive)
        !            27:   (rmail-new-summary "Full summary" nil))
        !            28: 
        !            29: (defun rmail-summary-by-labels (labels)
        !            30:   "Display a summary of all messages with one or more LABELS.
        !            31: LABELS should be a string containing the desired labels, separated by commas."
        !            32:   (interactive "sLabels to summarize by: ")
        !            33:   (if (string= labels "")
        !            34:       (setq labels (or rmail-last-multi-labels
        !            35:                       (error "No label specified"))))
        !            36:   (setq rmail-last-multi-labels labels)
        !            37:   (rmail-new-summary (concat "Summary of " labels)
        !            38:                     'rmail-message-labels-p
        !            39:                     (concat ",\\(" (mail-comma-list-regexp labels) "\\),")))
        !            40: 
        !            41: (defun rmail-summary-by-recipients (recipients &optional primary-only)
        !            42:   "Display a summary of all messages with the given RECIPIENTS.
        !            43: Normally checks the To, From and Cc fields of headers;
        !            44: but if PRIMARY-ONLY is non-nil (prefix arg given),
        !            45:  only look in the To and From fields.
        !            46: RECIPIENTS is a string of names separated by commas."
        !            47:   (interactive "sRecipients to summarize by:  \nP")
        !            48:   (rmail-new-summary
        !            49:    (concat "Summary of " recipients)
        !            50:    'rmail-message-recipients-p
        !            51:    (mail-comma-list-regexp recipients) primary-only))
        !            52: 
        !            53: (defun rmail-message-recipients-p (msg recipients &optional primary-only)
        !            54:   (save-restriction
        !            55:     (goto-char (rmail-msgbeg msg))
        !            56:     (search-forward "\n*** EOOH ***\n")
        !            57:     (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
        !            58:     (or (string-match recipients (or (mail-fetch-field "To") ""))
        !            59:        (string-match recipients (or (mail-fetch-field "From") ""))
        !            60:        (if (not primary-only)
        !            61:            (string-match recipients (or (mail-fetch-field "Cc") ""))))))
        !            62: 
        !            63: (defun rmail-new-summary (description function &rest args)
        !            64:   "Create a summary of selected messages.
        !            65: DESCRIPTION makes part of the mode line of the summary buffer.
        !            66: For each message, FUNCTION is applied to the message number and ARGS...
        !            67: and if the result is non-nil, that message is included.
        !            68: nil for FUNCTION means all messages."
        !            69:   (message "Computing summary lines...")
        !            70:   (or (and rmail-summary-buffer
        !            71:           (buffer-name rmail-summary-buffer))
        !            72:       (setq rmail-summary-buffer
        !            73:            (generate-new-buffer (concat (buffer-name) "-summary"))))
        !            74:   (let (summary-msgs)
        !            75:     (let ((msgnum 1)
        !            76:          (new-summary-line-count 0)
        !            77:          (buffer-read-only nil))
        !            78:       (save-restriction
        !            79:        (save-excursion
        !            80:          (widen)
        !            81:          (goto-char (point-min))
        !            82:          (while (>= rmail-total-messages msgnum)
        !            83:            (if (or (null function)
        !            84:                    (apply function (cons msgnum args)))
        !            85:                (setq summary-msgs
        !            86:                      (cons (rmail-make-summary-line msgnum)
        !            87:                            summary-msgs)))
        !            88:            (setq msgnum (1+ msgnum))))))
        !            89:     (let ((sbuf rmail-summary-buffer)
        !            90:          (rbuf (current-buffer))
        !            91:          (total rmail-total-messages)
        !            92:          (mesg rmail-current-message))
        !            93:       (pop-to-buffer sbuf)
        !            94:       (let (buffer-read-only)
        !            95:        (erase-buffer)
        !            96:        (cond (summary-msgs
        !            97:               (princ (nreverse summary-msgs) sbuf)
        !            98:               (delete-char -1)
        !            99:               (subst-char-in-region 1 2 ?\( ?\ ))))
        !           100:       (setq buffer-read-only t)
        !           101:       (goto-char (point-min))
        !           102:       (rmail-summary-mode)
        !           103:       (rmail-summary-mode-line description)
        !           104:       (setq rmail-buffer rbuf
        !           105:            rmail-total-messages total)
        !           106:       (if (> total 0)
        !           107:          (rmail-summary-goto-msg mesg t))))
        !           108:   (message "Computing summary lines...done"))
        !           109: 
        !           110: (defun rmail-make-summary-line (msg)
        !           111:   (let ((line (or (aref rmail-summary-vector (1- msg))
        !           112:                  (progn
        !           113:                    (setq new-summary-line-count
        !           114:                          (1+ new-summary-line-count))
        !           115:                    (if (zerop (% new-summary-line-count 10))
        !           116:                        (message "Computing summary lines...%d"
        !           117:                                 new-summary-line-count))
        !           118:                    (rmail-make-summary-line-1 msg)))))
        !           119:     ;; Fix up the part of the summary that says "deleted" or "unseen".
        !           120:     (aset line 4
        !           121:          (if (rmail-message-deleted-p msg) ?\D
        !           122:            (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg))))
        !           123:                ?\- ?\ )))
        !           124:     line))
        !           125: 
        !           126: (defun rmail-make-summary-line-1 (msg)
        !           127:   (goto-char (rmail-msgbeg msg))
        !           128:   (let* ((lim (save-excursion (forward-line 2) (point)))
        !           129:         pos
        !           130:         (labels
        !           131:          (progn
        !           132:            (forward-char 3)
        !           133:            (concat
        !           134: ;           (if (save-excursion (re-search-forward ",answered," lim t))
        !           135: ;               "*" "")
        !           136: ;           (if (save-excursion (re-search-forward ",filed," lim t))
        !           137: ;               "!" "")
        !           138:             (if (progn (search-forward ",,") (eolp))
        !           139:                 ""
        !           140:               (concat "{"
        !           141:                       (buffer-substring (point)
        !           142:                                         (progn (end-of-line) (point)))
        !           143:                       "} ")))))
        !           144:         (line
        !           145:          (progn
        !           146:            (forward-line 1)
        !           147:            (if (looking-at "Summary-line: ")
        !           148:                (progn
        !           149:                  (goto-char (match-end 0))
        !           150:                  (setq line
        !           151:                        (buffer-substring (point)
        !           152:                                          (progn (forward-line 1) (point)))))))))
        !           153:     ;; Obsolete status lines lacking a # should be flushed.
        !           154:     (and line
        !           155:         (not (string-match "#" line))
        !           156:         (progn
        !           157:           (delete-region (point)
        !           158:                          (progn (forward-line -1) (point)))
        !           159:           (setq line nil)))
        !           160:     ;; If we didn't get a valid status line from the message,
        !           161:     ;; make a new one and put it in the message.
        !           162:     (or line
        !           163:        (let* ((case-fold-search t)
        !           164:               (next (rmail-msgend msg))
        !           165:               (beg (if (progn (goto-char (rmail-msgbeg msg))
        !           166:                               (search-forward "\n*** EOOH ***\n" next t))
        !           167:                        (point)
        !           168:                      (forward-line 1)
        !           169:                      (point)))
        !           170:               (end (progn (search-forward "\n\n" nil t) (point))))
        !           171:          (save-restriction
        !           172:            (narrow-to-region beg end)
        !           173:            (goto-char beg)
        !           174:            (setq line (rmail-make-basic-summary-line)))
        !           175:          (goto-char (rmail-msgbeg msg))
        !           176:          (forward-line 2)
        !           177:          (insert "Summary-line: " line)))
        !           178:     (setq pos (string-match "#" line))
        !           179:     (aset rmail-summary-vector (1- msg)
        !           180:          (concat (format "%4d  " msg)
        !           181:                  (substring line 0 pos)
        !           182:                  labels
        !           183:                  (substring line (1+ pos))))))
        !           184: 
        !           185: (defun rmail-make-basic-summary-line ()
        !           186:   (goto-char (point-min))
        !           187:   (concat (save-excursion
        !           188:            (if (not (search-forward "Date:" nil t))
        !           189:                "      "
        !           190:              (if (re-search-forward
        !           191:                   "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([ \t-_]+\\)\\([a-z][a-z][a-z]\\)"
        !           192:                   (save-excursion (end-of-line) (point)) t)
        !           193:                  (format "%2s-%3s"
        !           194:                          (buffer-substring
        !           195:                           (match-beginning 2) (match-end 2))
        !           196:                          (buffer-substring
        !           197:                           (match-beginning 4) (match-end 4)))
        !           198:                (if (not (re-search-forward
        !           199:                          "\\([^a-z]\\)\\([a-z][a-z][a-z]\\)\\([a-z \t-_]*\\)\\([0-9][0-9]?\\)"
        !           200:                          (save-excursion (end-of-line) (point)) t))
        !           201:                    "??????"
        !           202:                  (format "%2s-%3s"
        !           203:                          (buffer-substring
        !           204:                           (match-beginning 4) (match-end 4))
        !           205:                          (buffer-substring
        !           206:                           (match-beginning 2) (match-end 2)))))))
        !           207:          "  "
        !           208:          (save-excursion
        !           209:            (if (not (search-forward "From:" nil t))
        !           210:                "                         "
        !           211:              (progn (skip-chars-forward " \t")
        !           212:                     (let* ((from (mail-strip-quoted-names
        !           213:                                   (buffer-substring
        !           214:                                    (1- (point))
        !           215:                                    (progn (end-of-line)
        !           216:                                           (skip-chars-backward " ")
        !           217:                                           (point)))))
        !           218:                            (len (length from))
        !           219:                            (mch (string-match "[@%]" from))
        !           220:                            lo)
        !           221:                       (format "%25s"
        !           222:                               (if (or (not mch) (<= len 25))
        !           223:                                   (substring from (max 0 (- len 25)))
        !           224:                                 (substring from
        !           225:                                            (setq lo (cond ((< (- mch 9) 0) 0)
        !           226:                                                           ((< len (+ mch 16))
        !           227:                                                            (- len 25))
        !           228:                                                           (t (- mch 9))))
        !           229:                                            (min len (+ lo 25)))))))))
        !           230:          "  #"
        !           231:          (if (search-forward "Subject:" nil t)
        !           232:              (progn (skip-chars-forward " \t")
        !           233:                     (buffer-substring (point)
        !           234:                                       (progn (end-of-line)
        !           235:                                              (point))))
        !           236:            (re-search-forward "[\n][\n]+" nil t)
        !           237:            (buffer-substring (point) (progn (end-of-line) (point))))
        !           238:          "\n"))
        !           239: 
        !           240: (defun rmail-summary-next-all (&optional number)
        !           241:   (interactive "p")
        !           242:   (forward-line (if number number 1))
        !           243:   (rmail-summary-goto-msg))
        !           244: 
        !           245: (defun rmail-summary-previous-all (&optional number)
        !           246:   (interactive "p")
        !           247:   (forward-line (- (if number number 1)))
        !           248:   (rmail-summary-goto-msg))
        !           249: 
        !           250: (defun rmail-summary-next-msg (&optional number)
        !           251:   (interactive "p")
        !           252:   (forward-line 0)
        !           253:   (and (> number 0) (forward-line 1))
        !           254:   (let ((count (if (< number 0) (- number) number))
        !           255:        (search (if (> number 0) 're-search-forward 're-search-backward))
        !           256:        end)
        !           257:     (while (and (> count 0) (funcall search "^.....[^D]" nil t))
        !           258:       (setq count (1- count)))
        !           259:     (rmail-summary-goto-msg)))
        !           260: 
        !           261: (defun rmail-summary-previous-msg (&optional number)
        !           262:   (interactive "p")
        !           263:   (rmail-summary-next-msg (- (if number number 1))))
        !           264: 
        !           265: (defun rmail-summary-delete-forward ()
        !           266:   (interactive)
        !           267:   (let (end)
        !           268:     (rmail-summary-goto-msg)
        !           269:     (pop-to-buffer rmail-buffer)
        !           270:     (rmail-delete-message)
        !           271:     (pop-to-buffer rmail-summary-buffer)
        !           272:     (let ((buffer-read-only nil))
        !           273:       (skip-chars-forward " ")
        !           274:       (skip-chars-forward "[0-9]")
        !           275:       (delete-char 1)
        !           276:       (insert "D"))
        !           277:     (rmail-summary-next-msg 1)))
        !           278: 
        !           279: (defun rmail-summary-undelete ()
        !           280:   (interactive)
        !           281:   (let ((buffer-read-only nil))
        !           282:     (end-of-line)
        !           283:     (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
        !           284:           (replace-match "\\1 ")
        !           285:           (rmail-summary-goto-msg)
        !           286:           (pop-to-buffer rmail-buffer)
        !           287:           (and (rmail-message-deleted-p rmail-current-message)
        !           288:                (rmail-undelete-previous-message))
        !           289:           (pop-to-buffer rmail-summary-buffer))
        !           290:          (t
        !           291:           (rmail-summary-goto-msg)))))
        !           292: 
        !           293: (defun rmail-summary-mode ()
        !           294:   "RMAIL Summary Mode.
        !           295: A subset of the Rmail mode commands are supported in this mode. 
        !           296: As commands are issued in the summary buffer the corresponding
        !           297: mail message is displayed in the rmail buffer.
        !           298: 
        !           299: n       Move to next undeleted message, or arg messages.
        !           300: p       Move to previous undeleted message, or arg messages.
        !           301: C-n    Move to next, or forward arg messages.
        !           302: C-p    Move to previous, or previous arg messages.
        !           303: j       Jump to the message at the cursor location.
        !           304: d       Delete the message at the cursor location and move to next message.
        !           305: u      Undelete this or previous deleted message.
        !           306: q      Quit Rmail.
        !           307: x      Exit and kill the summary window.
        !           308: space   Scroll message in other window forward.
        !           309: delete  Scroll message backward.
        !           310: 
        !           311: Entering this mode calls value of hook variable rmail-summary-mode-hook."
        !           312:   (interactive)
        !           313:   (kill-all-local-variables)
        !           314:   (make-local-variable 'rmail-buffer)
        !           315:   (make-local-variable 'rmail-total-messages)
        !           316:   (setq major-mode 'rmail-summary-mode)
        !           317:   (setq mode-name "RMAIL Summary")
        !           318:   (use-local-map rmail-summary-mode-map)
        !           319:   (setq truncate-lines t)
        !           320:   (setq buffer-read-only t)
        !           321:   (set-syntax-table text-mode-syntax-table)
        !           322:   (run-hooks 'rmail-summary-mode-hook))
        !           323: 
        !           324: (defun rmail-summary-mode-line (description)
        !           325:   (setq mode-line-format
        !           326:        (concat "---Emacs: %17b   %M   %[(" description ")%]----%3p-%-")))
        !           327: 
        !           328: (defun rmail-summary-goto-msg (&optional n nowarn)
        !           329:   (interactive "P")
        !           330:   (if (consp n) (setq n (prefix-numeric-value n)))
        !           331:   (if (eobp) (forward-line -1))
        !           332:   (beginning-of-line)
        !           333:   (let ((buf rmail-buffer)
        !           334:        (cur (point))
        !           335:        (curmsg (string-to-int (buffer-substring (point) (+ 5 (point))))))
        !           336:     (if (not n)
        !           337:        (setq n curmsg)
        !           338:       (if (< n 1)
        !           339:          (progn (message "No preceding message")
        !           340:                 (setq n 1)))
        !           341:       (if (> n rmail-total-messages)
        !           342:          (progn (message "No following message")
        !           343:                 (goto-char (point-max))
        !           344:                 (rmail-summary-goto-msg)))
        !           345:       (goto-char (point-min))
        !           346:       (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
        !           347:          (progn (or nowarn (message "Message %d not found" n))
        !           348:                 (setq n curmsg)
        !           349:                 (goto-char cur))))
        !           350:     (beginning-of-line)
        !           351:     (skip-chars-forward " ")
        !           352:     (skip-chars-forward "0-9")
        !           353:     (save-excursion (if (= (following-char) ?-)
        !           354:                        (let ((buffer-read-only nil))
        !           355:                          (delete-char 1)
        !           356:                          (insert " "))))
        !           357:     (beginning-of-line)
        !           358:     (pop-to-buffer buf)
        !           359:     (rmail-show-message n)
        !           360:     (pop-to-buffer rmail-summary-buffer)))
        !           361: 
        !           362: (defvar rmail-summary-mode-map nil)
        !           363: 
        !           364: (if rmail-summary-mode-map
        !           365:     nil
        !           366:   (setq rmail-summary-mode-map (make-keymap))
        !           367:   (suppress-keymap rmail-summary-mode-map)
        !           368:   (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
        !           369:   (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
        !           370:   (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
        !           371:   (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all)
        !           372:   (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all)
        !           373:   (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
        !           374:   (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
        !           375:   (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
        !           376:   (define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
        !           377:   (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
        !           378:   (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward))
        !           379: 
        !           380: (defun rmail-summary-scroll-msg-up (&optional dist)
        !           381:   "Scroll message in top window forward"
        !           382:   (interactive "P")
        !           383:   (scroll-other-window (if (null dist)
        !           384:                           nil
        !           385:                         (prefix-numeric-value dist))))
        !           386: 
        !           387: (defun rmail-summary-scroll-msg-down (&optional dist)
        !           388:   "Scroll message in top window backward"
        !           389:   (interactive "P")
        !           390:   (other-window 1)
        !           391:   (scroll-down (if (null dist)
        !           392:                   nil
        !           393:                 (prefix-numeric-value dist)))
        !           394:   (other-window 1))
        !           395: 
        !           396: (defun rmail-summary-quit ()
        !           397:   "Quit out of rmail and rmail summary"
        !           398:   (interactive)
        !           399:   (rmail-summary-exit)
        !           400:   (rmail-quit))
        !           401: 
        !           402: (defun rmail-summary-exit ()
        !           403:   "Exit rmail summary, remaining within rmail."
        !           404:   (interactive)
        !           405:   ;; Switch to the rmail buffer after burying this one.
        !           406:   ;; Tricky since variable rmail-buffer is local.
        !           407:   (pop-to-buffer (prog1 rmail-buffer (bury-buffer (current-buffer))))
        !           408:   (delete-other-windows))

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