X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5f98a1d819065593407e75bfbeec7c0e43908bde..f2e3589a330a23ec37d00700385323e2265b8a49:/lisp/mail/mail-hist.el diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el index 88ccd0dcc1..c718110e9e 100644 --- a/lisp/mail/mail-hist.el +++ b/lisp/mail/mail-hist.el @@ -1,7 +1,9 @@ -;;; mail-hist.el --- Headers and message body history for outgoing mail. -;; Copyright (C) 1994 Free Software Foundation, Inc. +;;; mail-hist.el --- headers and message body history for outgoing mail -;; Author: Karl Fogel +;; Copyright (C) 1994, 2001, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. + +;; Author: Karl Fogel ;; Created: March, 1994 ;; Keywords: mail, history @@ -17,11 +19,12 @@ ;; 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., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: ;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of ;; time. @@ -53,6 +56,12 @@ ;;; 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 () @@ -70,13 +79,17 @@ 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) @@ -93,17 +106,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." - (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 @@ -111,22 +118,19 @@ the message." (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). 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." - (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) @@ -169,8 +173,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) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$"))) + (goto-char (mail-header-end))) (beginning-of-line) (buffer-substring start (1- (point)))))) @@ -180,13 +183,14 @@ 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 +(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.") +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." + "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))) @@ -209,11 +213,11 @@ Optional argument CONTENTS is a string which will be the contents ;;;###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 @@ -222,44 +226,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 - (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))))) - -(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"))) + + +(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. @@ -268,33 +284,15 @@ 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))) - (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)) + (provide 'mail-hist) -;; mail-hist.el ends here +;;; arch-tag: 9ff9a07c-9dca-482d-ba87-54f42778559d +;;; mail-hist.el ends here