Return to rmailsum.el CVS log

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

Annotation of 43BSDReno/contrib/emacs-18.55/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 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 "All" 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 "labels " 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 "recipients " 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:        (new-summary-line-count 0))
        !            76:     (let ((msgnum 1)
        !            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 nil))
        !            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:       (make-local-variable 'minor-mode-alist)
        !           104:       (setq minor-mode-alist (list ": " description))
        !           105:       (setq rmail-buffer rbuf
        !           106:            rmail-total-messages total)
        !           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 (re-search-forward "^Date:" nil t))
        !           189:                "      "
        !           190:              (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
        !           191:                      (save-excursion (end-of-line) (point)) t)
        !           192:                     (format "%2d-%3s"
        !           193:                             (string-to-int (buffer-substring
        !           194:                                             (match-beginning 2)
        !           195:                                             (match-end 2)))
        !           196:                             (buffer-substring
        !           197:                              (match-beginning 4) (match-end 4))))
        !           198:                    ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
        !           199:                      (save-excursion (end-of-line) (point)) t)
        !           200:                     (format "%2d-%3s"
        !           201:                             (string-to-int (buffer-substring
        !           202:                                             (match-beginning 4)
        !           203:                                             (match-end 4)))
        !           204:                             (buffer-substring
        !           205:                              (match-beginning 2) (match-end 2))))
        !           206:                    (t "??????"))))
        !           207:          "  "
        !           208:          (save-excursion
        !           209:            (if (not (re-search-forward "^From:[ \t]*" nil t))
        !           210:                "                         "
        !           211:              (let* ((from (mail-strip-quoted-names
        !           212:                            (buffer-substring
        !           213:                             (1- (point))
        !           214:                             (progn (end-of-line)
        !           215:                                    (skip-chars-backward " \t")
        !           216:                                    (point)))))
        !           217:                     len mch lo)
        !           218:                (if (string-match (concat "^"
        !           219:                                          (regexp-quote (user-login-name))
        !           220:                                          "\\($\\|@\\)")
        !           221:                                  from)
        !           222:                    (save-excursion
        !           223:                      (goto-char (point-min))
        !           224:                      (if (not (re-search-forward "^To:[ \t]*" nil t))
        !           225:                          nil
        !           226:                        (setq from
        !           227:                              (concat "to: "
        !           228:                                      (mail-strip-quoted-names
        !           229:                                       (buffer-substring
        !           230:                                        (point)
        !           231:                                        (progn (end-of-line)
        !           232:                                               (skip-chars-backward " \t")
        !           233:                                               (point)))))))))
        !           234:                (setq len (length from))
        !           235:                (setq mch (string-match "[@%]" from))
        !           236:                (format "%25s"
        !           237:                        (if (or (not mch) (<= len 25))
        !           238:                            (substring from (max 0 (- len 25)))
        !           239:                          (substring from
        !           240:                                     (setq lo (cond ((< (- mch 9) 0) 0)
        !           241:                                                    ((< len (+ mch 16))
        !           242:                                                     (- len 25))
        !           243:                                                    (t (- mch 9))))
        !           244:                                     (min len (+ lo 25))))))))
        !           245:          "  #"
        !           246:          (if (re-search-forward "^Subject:" nil t)
        !           247:              (progn (skip-chars-forward " \t")
        !           248:                     (buffer-substring (point)
        !           249:                                       (progn (end-of-line)
        !           250:                                              (point))))
        !           251:            (re-search-forward "[\n][\n]+" nil t)
        !           252:            (buffer-substring (point) (progn (end-of-line) (point))))
        !           253:          "\n"))
        !           254: 
        !           255: (defun rmail-summary-next-all (&optional number)
        !           256:   (interactive "p")
        !           257:   (forward-line (if number number 1))
        !           258:   (rmail-summary-goto-msg))
        !           259: 
        !           260: (defun rmail-summary-previous-all (&optional number)
        !           261:   (interactive "p")
        !           262:   (forward-line (- (if number number 1)))
        !           263:   (rmail-summary-goto-msg))
        !           264: 
        !           265: (defun rmail-summary-next-msg (&optional number)
        !           266:   (interactive "p")
        !           267:   (forward-line 0)
        !           268:   (and (> number 0) (forward-line 1))
        !           269:   (let ((count (if (< number 0) (- number) number))
        !           270:        (search (if (> number 0) 're-search-forward 're-search-backward))
        !           271:        end)
        !           272:     (while (and (> count 0) (funcall search "^.....[^D]" nil t))
        !           273:       (setq count (1- count)))
        !           274:     (rmail-summary-goto-msg)))
        !           275: 
        !           276: (defun rmail-summary-previous-msg (&optional number)
        !           277:   (interactive "p")
        !           278:   (rmail-summary-next-msg (- (if number number 1))))
        !           279: 
        !           280: (defun rmail-summary-delete-forward ()
        !           281:   (interactive)
        !           282:   (let (end)
        !           283:     (rmail-summary-goto-msg)
        !           284:     (pop-to-buffer rmail-buffer)
        !           285:     (rmail-delete-message)
        !           286:     (pop-to-buffer rmail-summary-buffer)
        !           287:     (let ((buffer-read-only nil))
        !           288:       (skip-chars-forward " ")
        !           289:       (skip-chars-forward "[0-9]")
        !           290:       (delete-char 1)
        !           291:       (insert "D"))
        !           292:     (rmail-summary-next-msg 1)))
        !           293: 
        !           294: (defun rmail-summary-undelete ()
        !           295:   (interactive)
        !           296:   (let ((buffer-read-only nil))
        !           297:     (end-of-line)
        !           298:     (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
        !           299:           (replace-match "\\1 ")
        !           300:           (rmail-summary-goto-msg)
        !           301:           (pop-to-buffer rmail-buffer)
        !           302:           (and (rmail-message-deleted-p rmail-current-message)
        !           303:                (rmail-undelete-previous-message))
        !           304:           (pop-to-buffer rmail-summary-buffer))
        !           305:          (t
        !           306:           (rmail-summary-goto-msg)))))
        !           307: 
        !           308: ;; Rmail Summary mode is suitable only for specially formatted data.
        !           309: (put 'rmail-summary-mode 'mode-class 'special)
        !           310: 
        !           311: (defun rmail-summary-mode ()
        !           312:   "Major mode in effect in Rmail summary buffer.
        !           313: A subset of the Rmail mode commands are supported in this mode. 
        !           314: As commands are issued in the summary buffer the corresponding
        !           315: mail message is displayed in the rmail buffer.
        !           316: 
        !           317: n       Move to next undeleted message, or arg messages.
        !           318: p       Move to previous undeleted message, or arg messages.
        !           319: C-n    Move to next, or forward arg messages.
        !           320: C-p    Move to previous, or previous arg messages.
        !           321: j       Jump to the message at the cursor location.
        !           322: d       Delete the message at the cursor location and move to next message.
        !           323: u      Undelete this or previous deleted message.
        !           324: q      Quit Rmail.
        !           325: x      Exit and kill the summary window.
        !           326: space   Scroll message in other window forward.
        !           327: delete  Scroll message backward.
        !           328: 
        !           329: Entering this mode calls value of hook variable rmail-summary-mode-hook."
        !           330:   (interactive)
        !           331:   (kill-all-local-variables)
        !           332:   (make-local-variable 'rmail-buffer)
        !           333:   (make-local-variable 'rmail-total-messages)
        !           334:   (setq major-mode 'rmail-summary-mode)
        !           335:   (setq mode-name "RMAIL Summary")
        !           336:   (use-local-map rmail-summary-mode-map)
        !           337:   (setq truncate-lines t)
        !           338:   (setq buffer-read-only t)
        !           339:   (set-syntax-table text-mode-syntax-table)
        !           340:   (run-hooks 'rmail-summary-mode-hook))
        !           341: 
        !           342: (defun rmail-summary-goto-msg (&optional n nowarn)
        !           343:   (interactive "P")
        !           344:   (if (consp n) (setq n (prefix-numeric-value n)))
        !           345:   (if (eobp) (forward-line -1))
        !           346:   (beginning-of-line)
        !           347:   (let ((buf rmail-buffer)
        !           348:        (cur (point))
        !           349:        (curmsg (string-to-int
        !           350:                 (buffer-substring (point)
        !           351:                                   (min (point-max) (+ 5 (point)))))))
        !           352:     (if (not n)
        !           353:        (setq n curmsg)
        !           354:       (if (< n 1)
        !           355:          (progn (message "No preceding message")
        !           356:                 (setq n 1)))
        !           357:       (if (> n rmail-total-messages)
        !           358:          (progn (message "No following message")
        !           359:                 (goto-char (point-max))
        !           360:                 (rmail-summary-goto-msg)))
        !           361:       (goto-char (point-min))
        !           362:       (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
        !           363:          (progn (or nowarn (message "Message %d not found" n))
        !           364:                 (setq n curmsg)
        !           365:                 (goto-char cur))))
        !           366:     (beginning-of-line)
        !           367:     (skip-chars-forward " ")
        !           368:     (skip-chars-forward "0-9")
        !           369:     (save-excursion (if (= (following-char) ?-)
        !           370:                        (let ((buffer-read-only nil))
        !           371:                          (delete-char 1)
        !           372:                          (insert " "))))
        !           373:     (beginning-of-line)
        !           374:     (pop-to-buffer buf)
        !           375:     (rmail-show-message n)
        !           376:     (pop-to-buffer rmail-summary-buffer)))
        !           377: 
        !           378: (defvar rmail-summary-mode-map nil)
        !           379: 
        !           380: (if rmail-summary-mode-map
        !           381:     nil
        !           382:   (setq rmail-summary-mode-map (make-keymap))
        !           383:   (suppress-keymap rmail-summary-mode-map)
        !           384:   (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
        !           385:   (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
        !           386:   (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
        !           387:   (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all)
        !           388:   (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all)
        !           389:   (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
        !           390:   (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
        !           391:   (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
        !           392:   (define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
        !           393:   (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
        !           394:   (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward))
        !           395: 
        !           396: (defun rmail-summary-scroll-msg-up (&optional dist)
        !           397:   "Scroll other window forward."
        !           398:   (interactive "P")
        !           399:   (scroll-other-window dist))
        !           400: 
        !           401: (defun rmail-summary-scroll-msg-down (&optional dist)
        !           402:   "Scroll other window backward."
        !           403:   (interactive "P")
        !           404:   (scroll-other-window
        !           405:    (cond ((eq dist '-) nil)
        !           406:         ((null dist) '-)
        !           407:         (t (- (prefix-numeric-value dist))))))
        !           408: 
        !           409: (defun rmail-summary-quit ()
        !           410:   "Quit out of rmail and rmail summary."
        !           411:   (interactive)
        !           412:   (rmail-summary-exit)
        !           413:   (rmail-quit))
        !           414: 
        !           415: (defun rmail-summary-exit ()
        !           416:   "Exit rmail summary, remaining within rmail."
        !           417:   (interactive)
        !           418:   (bury-buffer (current-buffer))
        !           419:   (if (get-buffer-window rmail-buffer)
        !           420:       ;; Select the window with rmail in it, then delete this window.
        !           421:       (select-window (prog1
        !           422:                         (get-buffer-window rmail-buffer)
        !           423:                       (delete-window (selected-window))))
        !           424:     ;; Switch to the rmail buffer in this window.
        !           425:     (switch-to-buffer rmail-buffer)))

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