(message-skip-to-next-address): New function.

(message-fill-header-address): Refactor.
(message-fill-address): Use it.
(message-delete-address): Use it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8aca415..733a802 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2004-05-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * message.el (message-skip-to-next-address): New function.
+       (message-fill-header-address): Refactor.
+       (message-fill-address): Use it.
+       (message-delete-address): Use it.
+
        * rfc2047.el (rfc2047-field-value): Strip props.
 
        * mail-parse.el (mail-header-make-address): New alias.

diff --git a/lisp/message.el b/lisp/message.el
index 2104bb7..ddf754b 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -2125,28 +2125,12 @@ Point is left at the beginning of the narrowed-to region."
             (1+ max)))))
       (message-sort-headers-1))))
 
-(defun message-delete-address ()
-  "Delete the address under point."
+(defun message-kill-address ()
+  "Kill the address under point."
   (interactive)
-  (let ((first t)
-       current-header addresses)
-    (save-restriction
-      (message-narrow-to-field)
-      (re-search-backward "[\t\n ,]" nil t)
-      (when (re-search-forward "[^\t\n ,]@[^\t\n ,]" nil t)
-       (setq current-header (match-string 0)
-             addresses (replace-regexp-in-string
-                        "[\n\t]" " " (mail-header-field-value)))
-       (goto-char (point-min))
-       (re-search-forward ": ?")
-       (delete-region (point) (point-max))
-       (dolist (address (mail-header-parse-addresses addresses))
-         (unless first
-           (insert ", "))
-         (setq first nil)
-         (unless (string-match (regexp-quote current-header) (car address))
-           (insert (mail-header-make-address
-                    (cdr address) (car address)))))))))
+  (let ((start (point)))
+    (message-skip-to-next-address)
+    (kill-region start (point))))
 
 \f
 
@@ -2219,6 +2203,7 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
   (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
 
+  (define-key message-mode-map "\C-c\M-k" 'message-kill-address)
   (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
   (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
   (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
@@ -5104,35 +5089,44 @@ Headers already prepared in the buffer are not modified."
 ;;; Setting up a message buffer
 ;;;
 
+(defun message-skip-to-next-address ()
+  (let ((end (save-excursion
+              (message-next-header)
+              (point)))
+       quoted char)
+    (when (looking-at ",")
+      (forward-char 1))
+    (while (and (not (= (point) end))
+               (or (not (eq char ?,))
+                   quoted))
+      (skip-chars-forward "^,\"" (point-max))
+      (when (eq (setq char (following-char)) ?\")
+       (setq quoted (not quoted)))
+      (unless (= (point) end)
+       (forward-char 1)))
+    (skip-chars-forward " \t\n")))
+
 (defun message-fill-address (header value)
+  (insert (capitalize (symbol-name header))
+         ": "
+         (if (consp value) (car value) value)
+         "\n")
+  (message-fill-header-address))
+
+(defun message-fill-header-address ()
   (save-restriction
-    (narrow-to-region (point) (point))
-    (insert (capitalize (symbol-name header))
-           ": "
-           (if (consp value) (car value) value)
-           "\n")
-    (narrow-to-region (point-min) (1- (point-max)))
-    (let (quoted last)
-      (goto-char (point-min))
-      (while (not (eobp))
-       (skip-chars-forward "^,\"" (point-max))
-       (if (or (eq (char-after) ?,)
-               (eobp))
-           (when (not quoted)
-             (if (and (> (current-column) 78)
-                      last)
-                 (progn
-                   (save-excursion
-                     (goto-char last)
-                     (insert "\n\t"))
-                   (setq last (1+ (point))))
-               (setq last (1+ (point)))))
-         (setq quoted (not quoted)))
-       (unless (eobp)
-         (forward-char 1))))
-    (goto-char (point-max))
-    (widen)
-    (forward-line 1)))
+    (message-narrow-to-field)
+    (while (not (eobp))
+      (message-skip-to-next-address)
+      (let (last)
+       (if (and (> (current-column) 78)
+                last)
+           (progn
+             (save-excursion
+               (goto-char last)
+               (insert "\n\t"))
+             (setq last (1+ (point))))
+         (setq last (1+ (point))))))))
 
 (defun message-split-line ()
   "Split current line, moving portion beyond point vertically down.