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 00a7d1c56ff3a128830f2eac21384fde7592482a..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
 


@@ -25,10 +25,6 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-

 ;; Thanks to Jim Blandy for mentioning ring.el.  It saved a lot of
 ;; time.
 ;;
 ;; Thanks to Jim Blandy for mentioning ring.el.  It saved a lot of
 ;; time.
 ;;


@@ -59,6 +55,12 @@
 \f
 ;;; Code:
 (require 'ring)
 \f
 ;;; Code:
 (require 'ring)

+(require 'sendmail)
+
+(defgroup mail-hist nil
+  "Headers and message body history for outgoing mail."
+  :prefix "mail-hist-"
+  :group 'mail)

 
 ;;;###autoload
 (defun mail-hist-define-keys ()
 
 ;;;###autoload
 (defun mail-hist-define-keys ()


@@ -76,13 +78,17 @@
 Used for knowing which history list to look in when the user asks for
 previous/next input.")
 
 Used for knowing which history list to look in when the user asks for
 previous/next input.")
 

-(defvar mail-hist-history-size (or kill-ring-max 1729)
+(defcustom mail-hist-history-size (or kill-ring-max 1729)

   "*The maximum number of elements in a mail field's history.
   "*The maximum number of elements in a mail field's history.

-Oldest elements are dumped first.")
+Oldest elements are dumped first."
+  :type 'integer
+  :group 'mail-hist)

 
 ;;;###autoload
 
 ;;;###autoload

-(defvar mail-hist-keep-history t
-  "*Non-nil means keep a history for headers and text of outgoing mail.")
+(defcustom mail-hist-keep-history t
+  "*Non-nil means keep a history for headers and text of outgoing mail."
+  :type 'boolean
+  :group 'mail-hist)

 
 ;; For handling repeated history requests
 (defvar mail-hist-access-count 0)
 
 ;; For handling repeated history requests
 (defvar mail-hist-access-count 0)


@@ -99,17 +105,11 @@ 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 (save-excursion
-        (re-search-backward (concat "^" (regexp-quote mail-header-separator)
-                                   "$")
-                           nil t))
+  (if (>= (point) (mail-text-start))

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

-      (let* ((body-start ; limit possibility of false headers
-              (save-excursion
-                (re-search-forward
-                (concat "^" (regexp-quote mail-header-separator) "$")
-                nil t)))
+      (let* ((body-start
+             (mail-text-start))

              (name-start
               (re-search-backward mail-hist-header-regexp nil t))
              (name-end
              (name-start
               (re-search-backward mail-hist-header-regexp nil t))
              (name-end


@@ -122,17 +122,14 @@ 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
 the header is empty."
 
 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
 the header is empty."

-  (let ((boundary (save-excursion
-                   (re-search-forward
-                    (concat "^" (regexp-quote mail-header-separator) "$")
-                    nil t))))
+  (let ((boundary (mail-header-end)))

     (and
     (and

-     boundary
+     (> boundary 0)

      (let ((unstopped t))
        (setq boundary (save-excursion
                     (goto-char boundary)
      (let ((unstopped t))
        (setq boundary (save-excursion
                     (goto-char boundary)


@@ -175,8 +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)

-          (re-search-forward
-          (concat "^" (regexp-quote mail-header-separator) "$")))
+          (goto-char (mail-header-end)))

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


@@ -186,13 +182,14 @@ HEADER is a string without the colon."
   (setq header (downcase header))
   (cdr (assoc header mail-hist-header-ring-alist)))
 
   (setq header (downcase header))
   (cdr (assoc header mail-hist-header-ring-alist)))
 

-(defvar mail-hist-text-size-limit nil
+(defcustom mail-hist-text-size-limit nil

   "*Don't store any header or body with more than this many characters.
   "*Don't store any header or body with more than this many characters.

-If the value is nil, that means no limit on text size.")
+If the value is nil, that means no limit on text size."
+  :type '(choice (const nil) integer)
+  :group 'mail-hist)

 
 (defun mail-hist-text-too-long-p (text)
 
 (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)))
 


@@ -215,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,44 +225,56 @@ This function normally would be called when the message is sent."
        (mail-hist-add-header-contents-to-ring
         (mail-hist-current-header-name)))
      (let ((body-contents
        (mail-hist-add-header-contents-to-ring
         (mail-hist-current-header-name)))
      (let ((body-contents

-            (save-excursion
-             (goto-char (point-min))
-             (re-search-forward
-              (concat "^" (regexp-quote mail-header-separator) "$")
-              nil)
-             (forward-line 1)
-             (buffer-substring (point) (point-max)))))
+           (buffer-substring (mail-text-start) (point-max))))

        (mail-hist-add-header-contents-to-ring "body" body-contents)))))
        (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.


@@ -274,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