Fix previous change:

[gnu-emacs] / lisp / mail / mail-hist.el

diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 4aceff7f408e6d20fde8a9fbacb06ed6721a8d75..da27b726efa8bb6af6976f8e8f8ad89ff1c46863 100644 (file)
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,8 +1,8 @@
-;;; mail-hist.el --- Headers and message body history for outgoing mail.
+;;; mail-hist.el --- headers and message body history for outgoing mail

 
 ;; Copyright (C) 1994 Free Software Foundation, Inc.
 
 
 ;; Copyright (C) 1994 Free Software Foundation, Inc.
 

-;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
+;; Author: Karl Fogel <kfogel@red-bean.com>

 ;; Created: March, 1994
 ;; Keywords: mail, history
 
 ;; Created: March, 1994
 ;; Keywords: mail, history
 


@@ -105,7 +105,7 @@ Oldest elements are dumped first."
   "Get name of mail header point is currently in, without the colon.
 Returns nil if not in a header, implying that point is in the body of
 the message."
   "Get name of mail header point is currently in, without the colon.
 Returns nil if not in a header, implying that point is in the body of
 the message."

-  (if (> (point) (mail-text-start))
+  (if (>= (point) (mail-text-start))

       nil ; then we are in the body of the message
     (save-excursion
       (let* ((body-start
       nil ; then we are in the body of the message
     (save-excursion
       (let* ((body-start


@@ -122,7 +122,7 @@ the message."
 (defsubst mail-hist-forward-header (count)
   "Move forward COUNT headers (backward if COUNT is negative).
 If last/first header is encountered first, stop there and returns
 (defsubst mail-hist-forward-header (count)
   "Move forward COUNT headers (backward if COUNT is negative).
 If last/first header is encountered first, stop there and returns

-nil.  
+nil.

 
 Places point on the first non-whitespace on the line following the
 colon after the header name, or on the second space following that if
 
 Places point on the first non-whitespace on the line following the
 colon after the header name, or on the second space following that if


@@ -172,7 +172,7 @@ colon, or just after the colon if it is not followed by whitespace."
     (mail-hist-beginning-of-header)
     (let ((start (point)))
       (or (mail-hist-forward-header 1)
     (mail-hist-beginning-of-header)
     (let ((start (point)))
       (or (mail-hist-forward-header 1)

-          (goto-char (mail-text-start)))
+          (goto-char (mail-header-end)))

       (beginning-of-line)
       (buffer-substring start (1- (point))))))
 
       (beginning-of-line)
       (buffer-substring start (1- (point))))))
 


@@ -189,8 +189,7 @@ If the value is nil, that means no limit on text size."
   :group 'mail-hist)
 
 (defun mail-hist-text-too-long-p (text)
   :group 'mail-hist)
 
 (defun mail-hist-text-too-long-p (text)

-  "Return t if TEXT does not exceed mail-hist's size limit.
-The variable `mail-hist-text-size-limit' defines this limit."
+  "Return non-nil if TEXT's length exceeds `mail-hist-text-size-limit'."

   (if mail-hist-text-size-limit
       (> (length text) mail-hist-text-size-limit)))
 
   (if mail-hist-text-size-limit
       (> (length text) mail-hist-text-size-limit)))
 


@@ -213,11 +212,11 @@ Optional argument CONTENTS is a string which will be the contents
 
 ;;;###autoload
 (defun mail-hist-put-headers-into-history ()
 
 ;;;###autoload
 (defun mail-hist-put-headers-into-history ()

-  "Put headers and contents of this message into mail header history. 
+  "Put headers and contents of this message into mail header history.

 Each header has its own independent history, as does the body of the
 message.
 
 Each header has its own independent history, as does the body of the
 message.
 

-This function normally would be called when the message is sent." 
+This function normally would be called when the message is sent."

   (and
    mail-hist-keep-history
    (save-excursion
   (and
    mail-hist-keep-history
    (save-excursion


@@ -228,36 +227,54 @@ This function normally would be called when the message is sent."
      (let ((body-contents
            (buffer-substring (mail-text-start) (point-max))))
        (mail-hist-add-header-contents-to-ring "body" body-contents)))))
      (let ((body-contents
            (buffer-substring (mail-text-start) (point-max))))
        (mail-hist-add-header-contents-to-ring "body" body-contents)))))

-\f
-(defun mail-hist-previous-input (header)
-  "Insert the previous contents of this mail header or message body.
-Moves back through the history of sent mail messages.  Each header has
-its own independent history, as does the body of the message.

 
 

-The history only contains the contents of outgoing messages, not
-received mail."
-  (interactive (list (or (mail-hist-current-header-name) "body")))
+
+\f
+(defun mail-hist-retrieve-and-insert (header access-func)
+  "Helper for `mail-hist-previous-input' and `mail-hist-next-input'."

   (setq header (downcase header))
   (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
          (len (ring-length ring))
          (repeat (eq last-command 'mail-hist-input-access)))
     (if repeat
         (setq mail-hist-access-count
   (setq header (downcase header))
   (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
          (len (ring-length ring))
          (repeat (eq last-command 'mail-hist-input-access)))
     (if repeat
         (setq mail-hist-access-count

-              (ring-plus1 mail-hist-access-count len))
+              (funcall access-func mail-hist-access-count len))

       (setq mail-hist-access-count 0))
     (if (null ring)
         (progn
           (ding)
           (message "No history for \"%s\"." header))
       (if (ring-empty-p ring)
       (setq mail-hist-access-count 0))
     (if (null ring)
         (progn
           (ding)
           (message "No history for \"%s\"." header))
       (if (ring-empty-p ring)

-          (error "\"%s\" ring is empty." header)
+          (error "\"%s\" ring is empty" header)

         (and repeat
              (delete-region (car mail-hist-last-bounds)
                             (cdr mail-hist-last-bounds)))
         (let ((start (point)))
           (insert (ring-ref ring mail-hist-access-count))
           (setq mail-hist-last-bounds (cons start (point)))
         (and repeat
              (delete-region (car mail-hist-last-bounds)
                             (cdr mail-hist-last-bounds)))
         (let ((start (point)))
           (insert (ring-ref ring mail-hist-access-count))
           (setq mail-hist-last-bounds (cons start (point)))

-          (setq this-command 'mail-hist-input-access))))))
+          (setq this-command 'mail-hist-input-access)
+          ;; Special case: when flipping through message bodies, it's
+          ;; usually most useful for point to stay at the top.  This
+          ;; is because the unique part of a message in a thread is
+          ;; more likely to be at the top than the bottom, as the
+          ;; bottom is often just the same quoted history for every
+          ;; message in the thread, differing only in indentation
+          ;; level.
+          (if (string-equal header "body")
+              (goto-char start)))
+        ))))
+
+
+(defun mail-hist-previous-input (header)
+  "Insert the previous contents of this mail header or message body.
+Moves back through the history of sent mail messages.  Each header has
+its own independent history, as does the body of the message.
+
+The history only contains the contents of outgoing messages, not
+received mail."
+  (interactive (list (or (mail-hist-current-header-name) "body")))
+  (mail-hist-retrieve-and-insert header 'ring-plus1))
+

 
 (defun mail-hist-next-input (header)
   "Insert next contents of this mail header or message body.
 
 (defun mail-hist-next-input (header)
   "Insert next contents of this mail header or message body.


@@ -266,33 +283,14 @@ its own independent history, as does the body of the message.
 
 Although you can do so, it does not make much sense to call this
 without having called `mail-hist-previous-header' first
 
 Although you can do so, it does not make much sense to call this
 without having called `mail-hist-previous-header' first

-(\\[mail-hist-previous-header]).
+\(\\[mail-hist-previous-header]).

 
 The history only contains the contents of outgoing messages, not
 received mail."
   (interactive (list (or (mail-hist-current-header-name) "body")))
 
 The history only contains the contents of outgoing messages, not
 received mail."
   (interactive (list (or (mail-hist-current-header-name) "body")))

-  (setq header (downcase header))
-  (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
-         (len (ring-length ring))
-         (repeat (eq last-command 'mail-hist-input-access)))
-    (if repeat
-        (setq mail-hist-access-count
-              (ring-minus1 mail-hist-access-count len))
-      (setq mail-hist-access-count 0))
-    (if (null ring)
-        (progn
-          (ding)
-          (message "No history for \"%s\"." header))
-      (if (ring-empty-p ring)
-          (error "\"%s\" ring is empty." header)
-        (and repeat
-             (delete-region (car mail-hist-last-bounds)
-                            (cdr mail-hist-last-bounds)))
-        (let ((start (point)))
-          (insert (ring-ref ring mail-hist-access-count))
-          (setq mail-hist-last-bounds (cons start (point)))
-          (setq this-command 'mail-hist-input-access))))))
+  (mail-hist-retrieve-and-insert header 'ring-minus1))
+

 \f
 (provide 'mail-hist)
 
 \f
 (provide 'mail-hist)
 

-;; mail-hist.el ends here
+;;; mail-hist.el ends here