Mercurial > emacs

changeset 15184:43360e066486

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(mail-hist-version): upped to 1.3.4. (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.
author Karl Fogel <kfogel@red-bean.com>
date Wed, 08 May 1996 02:38:37 +0000
parents 9c770d2b753f
children 44305fd68269
files lisp/mail/mail-hist.el
diffstat 1 files changed, 119 insertions(+), 109 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/mail/mail-hist.el	Wed May 08 02:22:12 1996 +0000
+++ b/lisp/mail/mail-hist.el	Wed May 08 02:38:37 1996 +0000
@@ -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 @@
 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 @@
 (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 @@
     (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 @@
   (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 @@
                 (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 @@
      (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 @@
 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 @@
 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)