From 47576bd860ad1c69d1db1fdd705a1b810435a3f8 Mon Sep 17 00:00:00 2001
From: "Brian A. LaMacchia" <edu/mit/csail/zurich/bal>
Date: Mon, 5 Aug 1991 16:40:11 +0000
Subject: [PATCH] Initial revision

---
 v7/src/edwin/rmailsrt.scm | 287 ++++++++++++++++++++++++
 v7/src/edwin/rmailsum.scm | 455 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 742 insertions(+)
 create mode 100644 v7/src/edwin/rmailsrt.scm
 create mode 100644 v7/src/edwin/rmailsum.scm

diff --git a/v7/src/edwin/rmailsrt.scm b/v7/src/edwin/rmailsrt.scm
new file mode 100644
index 000000000..3270ff834
--- /dev/null
+++ b/v7/src/edwin/rmailsrt.scm
@@ -0,0 +1,287 @@
+;;; -*-Scheme-*-
+;;;
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmailsrt.scm,v 1.1 1991/08/05 16:40:11 bal Exp $
+;;;
+;;;	Copyright (c) 1991 Massachusetts Institute of Technology
+;;;
+;;;	This material was developed by the Scheme project at the
+;;;	Massachusetts Institute of Technology, Department of
+;;;	Electrical Engineering and Computer Science.  Permission to
+;;;	copy this software, to redistribute it, and to use it for any
+;;;	purpose is granted, subject to the following restrictions and
+;;;	understandings.
+;;;
+;;;	1. Any copy made of this software must include this copyright
+;;;	notice in full.
+;;;
+;;;	2. Users of this software agree to make their best efforts (a)
+;;;	to return to the MIT Scheme project any improvements or
+;;;	extensions that they make, so that these may be included in
+;;;	future releases; and (b) to inform MIT of noteworthy uses of
+;;;	this software.
+;;;
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
+;;;	research.
+;;;
+;;;	4. MIT has made no warrantee or representation that the
+;;;	operation of this software will be error-free, and MIT is
+;;;	under no obligation to provide any services, by way of
+;;;	maintenance, update, or otherwise.
+;;;
+;;;	5. In conjunction with products arising from the use of this
+;;;	material, there shall be no use of the name of the
+;;;	Massachusetts Institute of Technology nor of any adaptation
+;;;	thereof in any advertising, promotional, or sales literature
+;;;	without prior written consent from MIT in each case.
+;;;
+;;; NOTE: Parts of this program (Edwin) were created by translation
+;;; from corresponding parts of GNU Emacs.  Users should be aware that
+;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts.  A copy
+;;; of that license should have been included along with this file.
+;;;
+
+;;;; RMAIL Sorting Utilities
+
+(declare (usual-integrations))
+
+;; GNUS compatible key bindings.
+(define-key 'rmail (list #\C-c #\C-s #\C-d) 'rmail-sort-by-date)
+(define-key 'rmail (list #\C-c #\C-s #\C-s) 'rmail-sort-by-subject)
+(define-key 'rmail (list #\C-c #\C-s #\C-a) 'rmail-sort-by-author)
+(define-key 'rmail (list #\C-c #\C-s #\C-r) 'rmail-sort-by-recipient)
+(define-key 'rmail (list #\C-c #\C-s #\C-l) 'rmail-sort-by-size-lines)
+
+(define-command rmail-sort-by-date 
+  "Sort messages of current Rmail file by date.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "P"
+  (lambda (reverse)
+    (rmail-sort-messages 
+     reverse
+     (lambda (memo)
+       (fetch-first-field "date" 
+			  (msg-memo/start memo)
+			  (msg-memo/end memo)))
+     (lambda (x y)
+       (string<?
+	(rmail-sortable-date-string x)
+	(rmail-sortable-date-string y))))))
+
+(define-command rmail-sort-by-subject 
+  "Sort messages of current Rmail file by subject.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "P"
+  (lambda (reverse)
+    (rmail-sort-messages 
+     reverse
+     (let ((re-pattern (re-compile-pattern "^\\(re:[ \t]+\\)*" true)))
+       (lambda (memo)
+	 (let ((key (or (fetch-first-field 
+			 "subject" 
+			 (msg-memo/start memo)
+			 (msg-memo/end memo))
+			""))
+	       (case-fold-search true))
+	   ;; Remove `Re:'
+	   (if (re-match-string-forward 
+		re-pattern true false key)
+	       (string-tail key (re-match-end-index 0))
+	       key))))
+     string<?)))
+
+(define-command rmail-sort-by-author 
+  "Sort messages of current Rmail file by author.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "P"
+  (lambda (reverse)
+    (rmail-sort-messages 
+     reverse
+     (lambda (memo)
+       (let ((start (msg-memo/start memo))
+	     (end (msg-memo/end memo)))
+	 (mail-strip-quoted-names
+	  (or (fetch-first-field "from" start end)
+	      (fetch-first-field "sender" start end)))))
+     string<?)))
+
+(define-command rmail-sort-by-recipient 
+  "Sort messages of current Rmail file by recipient.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "P"
+  (lambda (reverse)
+    (rmail-sort-messages 
+     reverse
+     (lambda (memo)
+       (let ((start (msg-memo/start memo))
+	     (end (msg-memo/end memo)))
+	 (mail-strip-quoted-names
+	  (or (fetch-first-field "to" start end)
+	      (fetch-first-field "apparently-to" start end)))))
+     string<?)))
+
+(define-command rmail-sort-by-size-lines 
+  "Sort messages of current Rmail file by message size.
+If prefix argument REVERSE is non-nil, sort them in reverse order."
+  "P"
+  (lambda (reverse)
+    (rmail-sort-messages
+     reverse
+     (lambda (memo)
+       (count-lines (msg-memo/start memo) (msg-memo/end memo)))
+     <)))
+
+
+(define rmail-sort-messages
+  (lambda (reverse keyfunc cmpfunc)
+    (let* ((current-msg-num (msg-memo/number (current-msg-memo)))
+	   (nummsg (-1+ (msg-memo/number (last-msg-memo))))
+	   (sort-vect (make-vector (1+ nummsg))))
+      (message "Finding sort keys...")
+      (widen)
+      (let loop ((n 0)
+		 (the-memo (msg-memo/first (current-msg-memo))))
+	(let ((next (msg-memo/next the-memo)))
+	  (if (= 9 (modulo n 10))
+	      (message "Finding sort keys..." (1+ n)))
+	  (vector-set! 
+	   sort-vect n
+	   (list (keyfunc the-memo)
+		 (extract-string
+		  (msg-memo/start the-memo)
+		  (msg-memo/end the-memo))
+		 the-memo))
+	  (if next (loop (1+ n) next))))
+      (if reverse
+	  (set! sort-vect
+		(list->vector (reverse (vector->list sort-vect)))))
+      (sort! sort-vect
+	     (lambda (x y)
+	       (cmpfunc (car x) (car y))))
+      (message "Reordering buffer...")
+      (set-buffer-writeable! (current-buffer))
+      (kill-string
+       (msg-memo/start (msg-memo/first (current-msg-memo)))
+       (msg-memo/end (msg-memo/last (current-msg-memo))))
+      (let loop ((n 0)
+		 (previous false)
+		 (the-memo (caddr (vector-ref sort-vect 0)))
+		 (next (if (>= nummsg 2)
+			   (caddr (vector-ref sort-vect 1))
+			   false)))
+	(set-msg-memo/previous! the-memo previous)
+	(set-msg-memo/next! the-memo next)
+	(if (< n nummsg)
+	    (begin
+	      (insert-string (cadr (vector-ref sort-vect n)))
+	      (if (= 9 (modulo n 10))
+		  (message "reordering buffer..." (1+ n)))
+	      (loop (1+ n) the-memo next
+		    (if (< (1+ n) nummsg)
+			(caddr (vector-ref sort-vect (1+ n)))
+			false)))
+	    (insert-string (cadr (vector-ref sort-vect n)))))
+      (set-buffer-read-only! (current-buffer))
+      (set-buffer-msg-memo! (current-buffer) false)
+      (memoize-buffer (current-buffer))
+      (show-message (current-buffer) current-msg-num))))
+
+;; Copy of the function gnus-comparable-date in gnus.el
+
+(define rmail-sortable-date-string
+  (lambda (date)
+    (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
+				 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
+				 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
+				 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
+	  (date (or date "")))
+    ;; Can understand the following styles:
+    ;; (1) 14 Apr 89 03:20:12 GMT
+    ;; (2) Fri, 17 Mar 89 4:01:33 GMT
+    ;;
+    ;; added [ ]+ to the regexp to handle date string put out
+    ;; by hx.lcs.mit.edu (they use 2 spaces instead of 1)
+      (if (re-match-string-forward
+	   (re-compile-pattern
+	    ".*\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\)[ ]+\\([0-9:]+\\)" true)
+	   true false date)
+	  (string-append
+	   ;; Year
+	   (let ((year (string->number (substring date (re-match-start-index 3) (re-match-end-index 3)))))
+	     (let ((y1 (modulo year 100)))
+	       (string-pad-left (number->string y1) 2)))
+	   ;; Month
+	   (cdr
+	    (assoc
+	     (string-upcase (substring (substring date (re-match-start-index 2) (re-match-end-index 2)) 0 3)) month))
+	   ;; Day
+	   (let ((day (substring date (re-match-start-index 1) (re-match-end-index 1))))
+	     (string-pad-left day 2))
+	   ;; Time
+	   (substring date (re-match-start-index 4) (re-match-end-index 4)))
+      ;; Cannot understand DATE string.
+	  date))))
+
+(define mail-string-delete
+  (lambda (string start end)
+    (string-append
+     (string-head string start)
+     (string-tail string end))))
+
+(define mail-strip-quoted-names
+  (lambda (address)
+    (let ((pos)
+	  (address address))
+      (if (re-match-string-forward (re-compile-pattern "\\`[ \t\n]*" true)
+				   true false address)
+	  (set! address (string-tail address (re-match-end-index 0))))
+      ;; strip surrounding whitespace
+      (if (re-match-string-forward (re-compile-pattern "[ \t\n]*\\'" true)
+				   true false address)
+	  (set! address (string-head address (re-match-start-index 0))))
+     (let loop ()
+       (let ((the-pattern 
+	      (re-compile-pattern
+	       "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)" true)))
+	 (set! pos (re-match-string-forward the-pattern true false address))
+	 (if pos
+	     (begin
+	       (set! address (mail-string-address 
+			      address pos
+			      (re-match-end-index 0)))
+	       (loop)))))
+     ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
+     (let loop ((the-pos 0))
+       (let ((the-pattern
+	      (re-compile-pattern
+	       "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
+	       true)))
+	 (set! pos (re-match-substring-forward the-pattern true false address
+					       the-pos (string-length address)))
+	 (if pos
+	     (if (and (> (string-length address) (re-match-end-index 0))
+		      (char=? (string-ref address (re-match-end-index 0)) #\@))
+		 (loop pos)
+		 (begin
+		   (set! address
+			 (mail-string-delete address
+					     the-pos (re-match-end-index 0)))
+		   (loop the-pos))))))
+     ;; Retain only part of address in <> delims, if there is such a thing.
+     (let loop ()
+       (let ((the-pattern
+	      (re-compile-pattern
+	       "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)"
+	       true)))
+	 (set! pos (re-match-string-forward the-pattern true false address))
+	 (if pos
+	     (let ((junk-beg (re-match-end-index 1))
+		   (junk-end (re-match-start-index 2))
+		   (close (re-match-end-index 0)))
+	       (set! address (mail-string-delete address (-1+ close) close))
+	       (set! address (mail-string-delete address junk-beg junk-end))
+	       (loop)))))
+     address)))
+
+
diff --git a/v7/src/edwin/rmailsum.scm b/v7/src/edwin/rmailsum.scm
new file mode 100644
index 000000000..c3be4f86c
--- /dev/null
+++ b/v7/src/edwin/rmailsum.scm
@@ -0,0 +1,455 @@
+;;; -*-Scheme-*-
+;;;
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmailsum.scm,v 1.1 1991/08/05 16:39:45 bal Exp $
+;;;
+;;;	Copyright (c) 1991 Massachusetts Institute of Technology
+;;;
+;;;	This material was developed by the Scheme project at the
+;;;	Massachusetts Institute of Technology, Department of
+;;;	Electrical Engineering and Computer Science.  Permission to
+;;;	copy this software, to redistribute it, and to use it for any
+;;;	purpose is granted, subject to the following restrictions and
+;;;	understandings.
+;;;
+;;;	1. Any copy made of this software must include this copyright
+;;;	notice in full.
+;;;
+;;;	2. Users of this software agree to make their best efforts (a)
+;;;	to return to the MIT Scheme project any improvements or
+;;;	extensions that they make, so that these may be included in
+;;;	future releases; and (b) to inform MIT of noteworthy uses of
+;;;	this software.
+;;;
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
+;;;	research.
+;;;
+;;;	4. MIT has made no warrantee or representation that the
+;;;	operation of this software will be error-free, and MIT is
+;;;	under no obligation to provide any services, by way of
+;;;	maintenance, update, or otherwise.
+;;;
+;;;	5. In conjunction with products arising from the use of this
+;;;	material, there shall be no use of the name of the
+;;;	Massachusetts Institute of Technology nor of any adaptation
+;;;	thereof in any advertising, promotional, or sales literature
+;;;	without prior written consent from MIT in each case.
+;;;
+;;; NOTE: Parts of this program (Edwin) were created by translation
+;;; from corresponding parts of GNU Emacs.  Users should be aware that
+;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts.  A copy
+;;; of that license should have been included along with this file.
+;;;
+
+;;;; RMAIL Summary Mode
+
+(declare (usual-integrations))
+
+(define rmail-summary-buffer false)
+
+(define-variable rmail-last-multi-labels
+  ""
+  ""
+  list-of-strings?)
+
+(define-command rmail-summary
+  "Display a summary of all messages, one line per message."
+  '()
+  (lambda ()
+    (rmail-new-summary "All" false)))
+
+;;;(define rmail-summary-by-labels
+;;;   "Display a summary of all messages with one or more LABELS.
+;;; LABELS should be a string containing the desired labels, separated by commas."
+;;;   "sLabels to summarize by: "
+;;;   (lambda (labels)
+;;;     (if (string=? labels "")
+;;; 	(set! labels (or rmail-last-multi-labels
+;;; 			 (error "No label specified"))))
+;;;     (set! rmail-last-multi-labels labels)
+;;;     (rmail-new-summary (string-append "labels " labels)
+;;; 		       rmail-message-labels?
+;;; 		       (string-append ", \\(" (mail-comma-list-regexp labels) "\\),"))))
+;;; 
+;;; (define rmail-summary-by-recipients 
+;;;   "Display a summary of all messages with the given RECIPIENTS.
+;;; Normally checks the To, From and Cc fields of headers;
+;;; but if PRIMARY-ONLY is non-nil (prefix arg given),
+;;;  only look in the To and From fields.
+;;; RECIPIENTS is a string of names separated by commas."
+;;;   (interactive "sRecipients to summarize by: \nP")
+;;;   (lambda (recipients primary-only)
+;;;     (rmail-new-summary
+;;;      (string-append "recipients " recipients)
+;;;      rmail-message-recipients?
+;;;      (mail-comma-list-regexp recipients) primary-only)))
+;;; 
+;;; ***HERE***
+;;; (define (rmail-message-recipients? msg recipients primary-only)
+;;;   (let ((the-current-point (current-point)))
+;;;     (set
+;;;   (goto-char (rmail-msgbeg msg))
+;;;     (search-forward "\n*** EOOH ***\n")
+;;;     (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
+;;;     (or (string-match recipients (or (mail-fetch-field "To") ""))
+;;; 	(string-match recipients (or (mail-fetch-field "From") ""))
+;;; 	(if (not primary-only)
+;;; 	    (string-match recipients (or (mail-fetch-field "Cc") ""))))))
+
+(define rmail-new-summary 
+  (lambda (description function . args)
+    (message "Computing summary lines...")
+    (if (not rmail-summary-buffer)
+	(set! rmail-summary-buffer
+	      (temporary-buffer (string-append (buffer-name (current-buffer)) "-summary"))))
+    (let ((summary-msgs ())
+	  (new-summary-line-count 0))
+      (let loop ((the-memo (msg-memo/first (current-msg-memo))))
+	(let ((next-memo (msg-memo/next the-memo)))
+	  (if (or (not function)
+		  (apply function (cons the-memo args)))
+	      (set! summary-msgs
+		    (cons (rmail-make-summary-line the-memo)
+			  summary-msgs)))
+	  (if next-memo
+	      (loop next-memo))))
+      (select-buffer rmail-summary-buffer)
+      (set-buffer-writeable! (current-buffer))
+      (set-current-point! (buffer-start (current-buffer)))
+      (kill-string (buffer-start (current-buffer))
+		   (buffer-end (current-buffer)))
+      (let loop ((the-summary-list (reverse summary-msgs)))
+	(if (not (null? the-summary-list))
+	    (begin
+	      (insert-string (car the-summary-list))
+	      (loop (cdr the-summary-list)))))
+;;;	       (subst-char-in-region 1 2 ?\( ?\ )
+      (set-buffer-read-only! (current-buffer))
+      (set-current-point! (buffer-start (current-buffer)))) 
+;      (rmail-summary-mode)
+;      ((ref-command make-local-variable) 'minor-mode-alist)
+;      (set-variable! minor-mode-alist (list ": " description))
+;      (rmail-summary-goto-msg mesg true)
+      (message "Computing summary lines...done")))
+
+(define (rmail-make-summary-line memo)
+  (let ((new-summary-line-count 0))
+    (let ((line (or (vector-ref rmail-summary-vector (-1+ (msg-memo/number memo)))
+		    (begin
+		      (set! new-summary-line-count
+			    (1+ new-summary-line-count))
+		      (if (= 0 (modulo new-summary-line-count 10))
+			  (message "Computing summary lines..."
+				   new-summary-line-count))
+		      (rmail-make-summary-line-1 memo)
+		      (vector-ref rmail-summary-vector (-1+ (msg-memo/number memo)))
+		      ))))
+      ;; Fix up the part of the summary that says "deleted" or "unseen".
+      (string-set! line 4
+		   (if (msg-memo/deleted? memo) #\D
+		       (if (char=? #\0 (string-ref (extract-string (msg-memo/start memo)
+								   (msg-memo/end memo))
+						   2))
+			   #\- #\space)))
+      line)))
+
+(define (rmail-make-summary-line-1 memo)
+  (with-buffer-open 
+   (current-buffer)
+   (lambda ()
+     (let ((old-point (current-point))
+	   (start (msg-memo/start memo))
+	   (end (msg-memo/end memo)))
+       (let ((lim
+	      (begin
+		(set-current-point! start)
+		((ref-command next-line) 2)
+		(current-point)))
+	     (pos)
+	     (labels
+	      (begin
+		(set-current-point! start)
+		(move-thing mark+ 3)
+		(if (and (search-forward ",," start end)
+			 (line-end? (current-point)))
+		    (let ((point (current-point)))
+		      (string-append 
+		       "{"
+		       (extract-string point (line-end point 0))
+		       "} "))
+		    "")))
+	     (line
+	      (begin
+		(set-current-point! start)
+		((ref-command next-line) 1)
+		(let ((point (current-point)))
+		  (if (string-prefix? 
+		       "Summary-line: "
+		       (extract-string point (line-end point 0)))
+		      (begin
+			(string-tail (extract-string point
+						     (begin
+						       ((ref-command next-line) 1)
+						       (current-point)))
+				     14))
+		      false)))))
+	 ;; If we didn't get a valid status line from the message,
+	 ;; make a new one and put it in the message.
+	 (or line
+	     (let ((inner-begin
+		    (let ((foo (search-forward "\n*** EOOH ***\n" start end)))
+		      (if foo
+			  foo
+			  (begin
+			    ((ref-command next-line) 1)
+			    (current-point))))))
+	       (set! line (rmail-make-basic-summary-line inner-begin))
+	       (insert-string (string-append "Summary-line: " line)
+			      (line-start start 2))))
+	 (set! pos (string-find-next-char line #\#))
+	 (let ((num (msg-memo/number memo)))
+	   (vector-set! rmail-summary-vector (-1+ num)
+			(string-append
+			 (string-pad-left (number->string num) 4)
+			 "  "
+			 (string-head line pos)
+			 labels
+			 (string-tail line (1+ pos))))))
+       (set-current-point! old-point)))))
+
+(define (rmail-make-basic-summary-line the-begin)
+  (string-append
+   (let ((the-mark
+	  (re-search-forward "^Date:" the-begin (group-end the-begin))))
+     (if (not the-mark)
+	 "      "
+	 (let ((the-end-of-line (line-end the-mark 0)))
+	   (cond
+	    ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" the-mark the-end-of-line)
+	     (string-append
+	      (string-pad-left (extract-string (re-match-start 2) (re-match-end 2)) 2)
+	      "-"
+	      (extract-string (re-match-start 4) (re-match-end 4))))
+	    ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" the-mark the-end-of-line)
+	     (string-append
+	      (string-pad-left (extract-string (re-match-start 4) (re-match-end 4)) 2)
+	      "-"
+	      (extract-string (re-match-start 2) (re-match-end 2))))
+	    (else
+	     "??????")))))
+   "  "
+   (let ((the-mark
+	  (re-search-forward "^From:[ \t]*" the-begin (group-end the-begin))))
+     (if (not the-mark)
+	 "                         "
+	 (let* ((from
+		 (mail-strip-quoted-names
+		  (extract-string
+		   the-mark
+		   (skip-chars-backward " \t" (line-end the-mark 0)))))
+		(len (string-length from))
+		(mch (string-find-next-char-in-set from (char-set #\@ #\%))))
+	   (substring
+	    (string-append
+	     (if (or (not mch) (<= len 25))
+		 (string-tail from (max 0 (- len 25)))
+		 (let ((lo
+			(cond ((< (- mch 9) 0) 0)
+			      ((< len (+ mch 16))
+			       (- len 25))
+			      (else
+			       (- mch 9)))))
+		   (substring from lo (min len (+ lo 25)))))
+	     "                         ")
+	    0 25))))
+   "  #"
+   (let ((the-mark
+	  (re-search-forward "^Subject:" the-begin (group-end the-begin))))
+     (if the-mark
+	 (let ((the-start (skip-chars-forward " \t" the-mark)))
+	   (extract-string the-start (line-end the-start 0)))
+	 (let ((the-start (re-search-forward "[\n][\n]+" the-begin (group-end the-begin))))
+	   (extract-string the-start (line-end the-start 0)))))
+   "\n"))
+
+(defun rmail-summary-next-all (&optional number)
+  (interactive "p")
+  (forward-line (if number number 1))
+  (rmail-summary-goto-msg))
+
+(defun rmail-summary-previous-all (&optional number)
+  (interactive "p")
+  (forward-line (- (if number number 1)))
+  (rmail-summary-goto-msg))
+
+(defun rmail-summary-next-msg (&optional number)
+  (interactive "p")
+  (forward-line 0)
+  (and (> number 0) (forward-line 1))
+  (let ((count (if (< number 0) (- number) number))
+	(search (if (> number 0) 're-search-forward 're-search-backward))
+	end)
+    (while (and (> count 0) (funcall search "^.....[^D]" nil t))
+      (setq count (1- count)))
+    (rmail-summary-goto-msg)))
+
+(defun rmail-summary-previous-msg (&optional number)
+  (interactive "p")
+  (rmail-summary-next-msg (- (if number number 1))))
+
+(defun rmail-summary-delete-forward ()
+  (interactive)
+  (let (end)
+    (rmail-summary-goto-msg)
+    (pop-to-buffer rmail-buffer)
+    (rmail-delete-message)
+    (pop-to-buffer rmail-summary-buffer)
+    (let ((buffer-read-only nil))
+      (skip-chars-forward " ")
+      (skip-chars-forward "[0-9]")
+      (delete-char 1)
+      (insert "D"))
+    (rmail-summary-next-msg 1)))
+
+(defun rmail-summary-undelete ()
+  (interactive)
+  (let ((buffer-read-only nil))
+    (end-of-line)
+    (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
+	   (replace-match "\\1 ")
+	   (rmail-summary-goto-msg)
+	   (pop-to-buffer rmail-buffer)
+	   (and (rmail-message-deleted-p rmail-current-message)
+		(rmail-undelete-previous-message))
+	   (pop-to-buffer rmail-summary-buffer))
+	  (t
+	   (rmail-summary-goto-msg)))))
+
+;; Rmail Summary mode is suitable only for specially formatted data.
+(put 'rmail-summary-mode 'mode-class 'special)
+
+(defun rmail-summary-mode ()
+  "Major mode in effect in Rmail summary buffer.
+A subset of the Rmail mode commands are supported in this mode. 
+As commands are issued in the summary buffer the corresponding
+mail message is displayed in the rmail buffer.
+
+n       Move to next undeleted message, or arg messages.
+p       Move to previous undeleted message, or arg messages.
+C-n	Move to next, or forward arg messages.
+C-p	Move to previous, or previous arg messages.
+j       Jump to the message at the cursor location.
+d       Delete the message at the cursor location and move to next message.
+u	Undelete this or previous deleted message.
+q	Quit Rmail.
+x	Exit and kill the summary window.
+space   Scroll message in other window forward.
+delete  Scroll message backward.
+
+Entering this mode calls value of hook variable rmail-summary-mode-hook."
+  (interactive)
+  (kill-all-local-variables)
+  (make-local-variable 'rmail-buffer)
+  (make-local-variable 'rmail-total-messages)
+  (setq major-mode 'rmail-summary-mode)
+  (setq mode-name "RMAIL Summary")
+  (use-local-map rmail-summary-mode-map)
+  (setq truncate-lines t)
+  (setq buffer-read-only t)
+  (set-syntax-table text-mode-syntax-table)
+  (run-hooks 'rmail-summary-mode-hook))
+
+(defun rmail-summary-goto-msg (&optional n nowarn)
+  (interactive "P")
+  (if (consp n) (setq n (prefix-numeric-value n)))
+  (if (eobp) (forward-line -1))
+  (beginning-of-line)
+  (let ((buf rmail-buffer)
+	(cur (point))
+	(curmsg (string-to-int
+		 (buffer-substring (point)
+				   (min (point-max) (+ 5 (point)))))))
+    (if (not n)
+	(setq n curmsg)
+      (if (< n 1)
+	  (progn (message "No preceding message")
+		 (setq n 1)))
+      (if (> n rmail-total-messages)
+	  (progn (message "No following message")
+		 (goto-char (point-max))
+		 (rmail-summary-goto-msg)))
+      (goto-char (point-min))
+      (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
+	  (progn (or nowarn (message "Message %d not found" n))
+		 (setq n curmsg)
+		 (goto-char cur))))
+    (beginning-of-line)
+    (skip-chars-forward " ")
+    (skip-chars-forward "0-9")
+    (save-excursion (if (= (following-char) ?-)
+			(let ((buffer-read-only nil))
+			  (delete-char 1)
+			  (insert " "))))
+    (beginning-of-line)
+    (pop-to-buffer buf)
+    (rmail-show-message n)
+    (pop-to-buffer rmail-summary-buffer)))
+
+(defvar rmail-summary-mode-map nil)
+
+(if rmail-summary-mode-map
+    nil
+  (setq rmail-summary-mode-map (make-keymap))
+  (suppress-keymap rmail-summary-mode-map)
+  (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
+  (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
+  (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
+  (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all)
+  (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all)
+  (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
+  (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
+  (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
+  (define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
+  (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
+  (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward))
+
+(defun rmail-summary-scroll-msg-up (&optional dist)
+  "Scroll other window forward."
+  (interactive "P")
+  (let ((window (selected-window))
+	(new-window (display-buffer rmail-buffer)))
+    (unwind-protect
+	(progn
+	  (select-window new-window)
+	  (scroll-up dist))
+      (select-window window))))
+
+(defun rmail-summary-scroll-msg-down (&optional dist)
+  "Scroll other window backward."
+  (interactive "P")
+  (let ((window (selected-window))
+	(new-window (display-buffer rmail-buffer)))
+    (unwind-protect
+	(progn
+	  (select-window new-window)
+	  (scroll-down dist))
+      (select-window window))))
+
+(defun rmail-summary-quit ()
+  "Quit out of rmail and rmail summary."
+  (interactive)
+  (rmail-summary-exit)
+  (rmail-quit))
+
+(defun rmail-summary-exit ()
+  "Exit rmail summary, remaining within rmail."
+  (interactive)
+  (bury-buffer (current-buffer))
+  (if (get-buffer-window rmail-buffer)
+      ;; Select the window with rmail in it, then delete this window.
+      (select-window (prog1
+			 (get-buffer-window rmail-buffer)
+		       (delete-window (selected-window))))
+    ;; Switch to the rmail buffer in this window.
+    (switch-to-buffer rmail-buffer)))
-- 
2.25.1