-;;; 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.
-;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
+;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: March, 1994
;; Keywords: mail, history
"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
(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
(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))))))
: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)))
;;;###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.
-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
(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
- (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)
- (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)))
- (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.
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)))
- (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)
-;; mail-hist.el ends here
+;;; mail-hist.el ends here
HCoop / bpt / emacs.git / blobdiff