Disable scrollbars until fully functional.

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

diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 7cef0dbfac7c0ee68588e933b1703991d5499f7c..88ccd0dcc1dddeecf2bb5b66b53ce33488b3404c 100644 (file)
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -3,8 +3,7 @@
 
 ;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
 ;; Created: March, 1994
-;; Version: 1.2.2
-;; Keywords: mail
+;; Keywords: mail, history
 
 ;; This file is part of GNU Emacs.
 
@@ -62,13 +61,9 @@
   (local-set-key "\M-n" 'mail-hist-next-input))
 
 ;;;###autoload
-(add-hook 'mail-mode-hook 'mail-hist-define-keys)
-
-;;;###autoload
-(add-hook 'vm-mail-mode-hook 'mail-hist-define-keys)
-
-;;;###autoload
-(add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
+(defun mail-hist-enable ()
+  (add-hook 'mail-mode-hook 'mail-hist-define-keys)
+  (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history))
 
 (defvar mail-hist-header-ring-alist nil
   "Alist of form (header-name . history-ring).
@@ -99,12 +94,16 @@ Oldest elements are dumped first.")
 Returns nil if not in a header, implying that point is in the body of
 the message."
   (if (save-excursion
-        (re-search-backward (concat "^" mail-header-separator) nil t))
+        (re-search-backward (concat "^" (regexp-quote mail-header-separator)
+                                   "$")
+                           nil t))
       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 "^" mail-header-separator) nil t)))
+                (re-search-forward
+                (concat "^" (regexp-quote mail-header-separator) "$")
+                nil t)))
              (name-start
               (re-search-backward mail-hist-header-regexp nil t))
              (name-end
@@ -112,7 +111,7 @@ the message."
         (and
          name-start
          name-end
-         (buffer-substring name-start name-end))))))
+         (downcase (buffer-substring name-start name-end)))))))
 
 (defsubst mail-hist-forward-header (count)
   "Move forward COUNT headers (backward if COUNT is negative).
@@ -123,7 +122,9 @@ 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 "^" mail-header-separator) nil t))))
+                   (re-search-forward
+                    (concat "^" (regexp-quote mail-header-separator) "$")
+                    nil t))))
     (and
      boundary
      (let ((unstopped t))
@@ -168,20 +169,35 @@ 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)
-          (re-search-forward (concat "^" mail-header-separator)))
+          (re-search-forward
+          (concat "^" (regexp-quote mail-header-separator) "$")))
       (beginning-of-line)
       (buffer-substring start (1- (point))))))
 
 (defsubst mail-hist-get-header-ring (header)
   "Get HEADER's history ring, or nil if none.
 HEADER is a string without the colon."
+  (setq header (downcase header))
   (cdr (assoc header mail-hist-header-ring-alist)))
 
+(defvar mail-hist-text-size-limit nil
+  "*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.")
+
+(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."
+  (if mail-hist-text-size-limit
+      (> (length text) mail-hist-text-size-limit)))
+
 (defsubst mail-hist-add-header-contents-to-ring (header &optional contents)
   "Add the contents of HEADER to the header history ring.
 Optional argument CONTENTS is a string which will be the contents
 \(instead of whatever's found in the header)."
-  (let ((ring (cdr (assoc header mail-hist-header-ring-alist))))
+  (setq header (downcase header))
+  (let ((ctnts (or contents (mail-hist-current-header-contents)))
+        (ring  (cdr (assoc header mail-hist-header-ring-alist))))
+    (if (mail-hist-text-too-long-p ctnts) (setq ctnts ""))
     (or ring
         ;; If the ring doesn't exist, we'll have to make it and add it
         ;; to the mail-header-ring-alist:
@@ -189,9 +205,7 @@ Optional argument CONTENTS is a string which will be the contents
             (setq ring (make-ring mail-hist-history-size))
           (setq mail-hist-header-ring-alist
                 (cons (cons header ring) mail-hist-header-ring-alist))))
-    (ring-insert
-     ring
-     (or contents (mail-hist-current-header-contents)))))
+    (ring-insert ring ctnts)))
 
 ;;;###autoload
 (defun mail-hist-put-headers-into-history ()
@@ -202,17 +216,19 @@ message.
 This function normally would be called when the message is sent." 
   (and
    mail-hist-keep-history
-   (progn
+   (save-excursion
      (goto-char (point-min))
      (while (mail-hist-forward-header 1)
        (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 "^" mail-header-separator) nil)
-            (forward-line 1)
-            (buffer-substring (point) (point-max)))))
+             (goto-char (point-min))
+             (re-search-forward
+              (concat "^" (regexp-quote mail-header-separator) "$")
+              nil)
+             (forward-line 1)
+             (buffer-substring (point) (point-max)))))
        (mail-hist-add-header-contents-to-ring "body" body-contents)))))
 \f
 (defun mail-hist-previous-input (header)
@@ -223,6 +239,7 @@ 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")))
+  (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)))
@@ -251,11 +268,12 @@ 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
-\(\\[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")))
+  (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)))