procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(mail-hist-version): upped to 1.3.4.

Browse source 
(mail-hist-put-headers-into-history): wrap relevant body in a
`save-excursion'.
(mail-hist-add-header-contents-to-ring): doc fix.
Use `mail-hist-text-size-limit' directly.
(mail-hist-text-size-limit): doc fix.
(mail-hist-text-too-long-p): removed, we don't need this func.
(mail-hist-forward-header): move to point just after colon, don't try
to treat whitespace specially.
(mail-hist-next-or-previous-input): new func, abstracts two funcs
below.
Error informatively if not in a header.
Compensate for the extra SPACE char in "virgin" headers.
(mail-hist-next-input): just call above.
(mail-hist-previous-input): same.
(mail-hist-header-virgin-p): new func.
This commit is contained in:
Karl Fogel 1996-05-08 02:38:37 +00:00
parent a15269c0d0
commit 1747a1941c
1 changed files with 119 additions and 109 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

228
lisp/mail/mail-hist.el
View file

@ -1,9 +1,9 @@
;;; 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>
;; Created: March, 1994
;; Version: See variable `mail-hist-version'.
;; Keywords: mail, history
;; This file is part of GNU Emacs.
@ -18,11 +18,6 @@
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; You should have received a copy of the GNU General Public License
@ -60,6 +55,9 @@
;;; Code:
(require 'ring)
(defconst mail-hist-version "1.3.4"
"The version number of this mail-hist package.")
;;;###autoload
(defun mail-hist-define-keys ()
"Define keys for accessing mail header history. For use in hooks."
@ -67,9 +65,13 @@
(local-set-key "\M-n" 'mail-hist-next-input))
;;;###autoload
(defun mail-hist-enable ()
(add-hook 'mail-mode-hook 'mail-hist-define-keys)
(add-hook 'mail-send-hook 'mail-hist-put-headers-into-history))
(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)
(defvar mail-hist-header-ring-alist nil
"Alist of form (header-name . history-ring).
@ -100,16 +102,14 @@ 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 "^" (regexp-quote 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 "^" (regexp-quote mail-header-separator) "$")
nil t)))
(concat "^" (regexp-quote mail-header-separator)) nil t)))
(name-start
(re-search-backward mail-hist-header-regexp nil t))
(name-end
@ -122,42 +122,40 @@ 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
nil.
nil.
Places point directly after the colon."
(let ((boundary
(save-excursion
(if (re-search-forward
(concat "^" (regexp-quote mail-header-separator)) nil t)
(progn
(beginning-of-line)
(1- (point)))
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))))
(and
boundary
(let ((unstopped t))
(setq boundary (save-excursion
(goto-char boundary)
(beginning-of-line)
(1- (point))))
(if (> count 0)
(while (> count 0)
(setq
unstopped
(re-search-forward mail-hist-header-regexp boundary t))
(setq count (1- count)))
;; because the current header will match too.
(setq count (1- count))
;; count is negative
(while (< count 0)
(setq
unstopped
(re-search-backward mail-hist-header-regexp nil t))
(setq count (1+ count)))
;; we end up behind the header, so must move to the front
(re-search-forward mail-hist-header-regexp boundary t))
;; Now we are right after the colon
(and (looking-at "\\s-") (forward-char 1))
;; return nil if didn't go as far as asked, otherwise point
unstopped))))
(if boundary
(let ((unstopped t))
(if (> count 0)
;; Moving forward.
(while (> count 0)
(setq
unstopped
(re-search-forward mail-hist-header-regexp boundary t))
(setq count (1- count)))
;; Else moving backward.
;; Decrement because the current header will match too.
(setq count (1- count))
;; count is negative
(while (< count 0)
(setq
unstopped
(re-search-backward mail-hist-header-regexp nil t))
(setq count (1+ count)))
;; We end up behind the header, so must move to the front.
(re-search-forward mail-hist-header-regexp boundary t))
;; Poof! Now we're sitting just past the colon. Finito.
;; Return nil if didn't go as far as asked, otherwise point
unstopped))))
(defsubst mail-hist-beginning-of-header ()
"Move to the start of the current header.
@ -176,7 +174,7 @@ colon, or just after the colon if it is not followed by whitespace."
(let ((start (point)))
(or (mail-hist-forward-header 1)
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")))
(concat "^" (regexp-quote mail-header-separator))))
(beginning-of-line)
(buffer-substring start (1- (point))))))
@ -186,24 +184,26 @@ 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)))
(defvar mail-hist-text-size-limit nil
"*Don't store any header or body with more than this many
characters, plus one. Nil means there will be no limit on text size.")
(defsubst mail-hist-add-header-contents-to-ring (header &optional contents)
"Add the contents of HEADER to the header history ring.
"Add the contents of the current HEADER to the header history ring.
HEADER is a string; it will be downcased.
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 ((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 ""))
;; Possibly truncate the text. Note that
;; `mail-hist-text-size-limit' might be nil, in which case no
;; truncation would take place.
(setq ctnts (substring ctnts 0 mail-hist-text-size-limit))
(or ring
;; If the ring doesn't exist, we'll have to make it and add it
;; to the mail-header-ring-alist:
@ -213,6 +213,7 @@ Optional argument CONTENTS is a string which will be the contents
(cons (cons header ring) mail-hist-header-ring-alist))))
(ring-insert ring ctnts)))
;;;###autoload
(defun mail-hist-put-headers-into-history ()
"Put headers and contents of this message into mail header history.
@ -227,16 +228,63 @@ This function normally would be called when the message is sent."
(while (mail-hist-forward-header 1)
(mail-hist-add-header-contents-to-ring
(mail-hist-current-header-name)))
;; We do body contents specially. This is bad. Had I thought to
;; include body-saving when I first wrote mail-hist, things might
;; be cleaner now. Sigh.
(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)))))
(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)))))
(defun mail-hist-header-virgin-p ()
"Return non-nil if it looks like this header had no contents.
If it has exactly one space following the colon, then we consider it
virgin."
(save-excursion
(mail-hist-forward-header -1)
(mail-hist-forward-header 1)
(looking-at " \n")))
(defun mail-hist-next-or-previous-input (header nextp)
"Insert next or 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."
(if (null header) (error "Not in a header."))
(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
(funcall (if nextp 'ring-minus1 'ring-plus1)
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)
(if repeat
(delete-region (car mail-hist-last-bounds)
(cdr mail-hist-last-bounds))
;; Else if this looks like a virgin header, we'll want to
;; get rid of its single space, because saved header
;; contents already include that space, and it's usually
;; desirable to have only one space between the colon and
;; the start of your header contents.
(if (mail-hist-header-virgin-p)
(delete-backward-char 1)))
(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))))))
(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
@ -245,27 +293,8 @@ 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)))
(if repeat
(setq mail-hist-access-count
(ring-plus1 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-next-or-previous-input header nil))
(defun mail-hist-next-input (header)
"Insert next contents of this mail header or message body.
@ -279,27 +308,8 @@ without having called `mail-hist-previous-header' first
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-next-or-previous-input header t))
(provide 'mail-hist)