;;; mail-hist.el --- Headers and message body history for outgoing mail.
+
;; Copyright (C) 1994 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
-;;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
;; time.
\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 ()
(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).
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.
-Oldest elements are dumped first.")
+Oldest elements are dumped first."
+ :type 'integer
+ :group 'mail-hist)
;;;###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)
"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
- (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
(and
name-start
name-end
- (downcase (buffer-substring name-start name-end)))))))
+ (downcase (buffer-substring-no-properties name-start name-end)))))))
(defsubst mail-hist-forward-header (count)
"Move forward COUNT headers (backward if COUNT is negative).
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
- boundary
+ (> boundary 0)
(let ((unstopped t))
(setq boundary (save-excursion
(goto-char boundary)
(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-start)))
(beginning-of-line)
(buffer-substring start (1- (point))))))
(setq header (downcase header))
(cdr (assoc header mail-hist-header-ring-alist)))
+(defcustom 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."
+ :type '(choice (const nil) integer)
+ :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."
+ (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)."
+\(instead of whatever's found in the header)."
(setq header (downcase header))
- (let ((ring (cdr (assoc header mail-hist-header-ring-alist))))
+ (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:
(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 ()
(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)))))
\f
(defun mail-hist-previous-input (header)