Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / message.el
index 651303b..4e67115 100644 (file)
@@ -668,7 +668,12 @@ The function `message-supersede' runs this hook."
 
 ;;;###autoload
 (defcustom message-citation-line-function 'message-insert-citation-line
-  "*Function called to insert the \"Whomever writes:\" line."
+  "*Function called to insert the \"Whomever writes:\" line.
+
+Note that Gnus provides a feature where the reader can click on
+`writes:' to hide the cited text.  If you change this line too much,
+people who read your message will have to change their Gnus
+configuration.  See the variable `gnus-cite-attribution-suffix'."
   :type 'function
   :group 'message-insertion)
 
@@ -949,10 +954,6 @@ candidates:
     table)
   "Syntax table used while in Message mode.")
 
-(defvar message-mode-abbrev-table text-mode-abbrev-table
-  "Abbrev table used in Message mode buffers.
-Defaults to `text-mode-abbrev-table'.")
-
 (defface message-header-to-face
   '((((class color)
       (background dark))
@@ -1778,7 +1779,7 @@ Point is left at the beginning of the narrowed-to region."
   (defvar facemenu-remove-face-function))
 
 ;;;###autoload
-(defun message-mode ()
+(define-derived-mode message-mode text-mode "Message"
   "Major mode for editing mail and news to be sent.
 Like Text Mode but with these additional commands:\\<message-mode-map>
 C-c C-s  `message-send' (send the message)  C-c C-c  `message-send-and-exit'
@@ -1791,6 +1792,7 @@ C-c C-f  move to a header field (and create it if there isn't):
         C-c C-f C-k  move to Keywords  C-c C-f C-d  move to Distribution
         C-c C-f C-m  move to Mail-Followup-To
         C-c C-f C-f  move to Followup-To
+        C-c C-f c    move to Mail-Copies-To
 C-c C-t  `message-insert-to' (add a To header to a news followup)
 C-c C-n  `message-insert-newsgroups' (add a Newsgroup header to a news reply)
 C-c C-b  `message-goto-body' (move to beginning of message text).
@@ -1803,33 +1805,22 @@ C-c C-v  `message-delete-not-region' (remove the text outside the region).
 C-c C-z  `message-kill-to-signature' (kill the text up to the signature).
 C-c C-r  `message-caesar-buffer-body' (rot13 the message body).
 M-RET    `message-newline-and-reformat' (break the line and reformat)."
-  (interactive)
-  (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
   (make-local-variable 'message-send-actions)
   (make-local-variable 'message-exit-actions)
   (make-local-variable 'message-kill-actions)
   (make-local-variable 'message-postpone-actions)
   (make-local-variable 'message-draft-article)
-  (make-local-hook 'kill-buffer-hook)
-  (set-syntax-table message-mode-syntax-table)
-  (use-local-map message-mode-map)
-  (setq local-abbrev-table message-mode-abbrev-table)
-  (setq major-mode 'message-mode)
-  (setq mode-name "Message")
   (setq buffer-offer-save t)
-  (make-local-variable 'facemenu-add-face-function)
-  (make-local-variable 'facemenu-remove-face-function)
-  (setq facemenu-add-face-function
-       (lambda (face end)
-         (let ((face-fun (cdr (assq face message-face-alist))))
-           (if face-fun
-               (funcall face-fun (point) end)
-             (error "Face %s not configured for %s mode" face mode-name)))
-         "")
-       facemenu-remove-face-function t)
-  (make-local-variable 'message-reply-headers)
-  (setq message-reply-headers nil)
+  (set (make-local-variable 'facemenu-add-face-function)
+       (lambda (face end)
+        (let ((face-fun (cdr (assq face message-face-alist))))
+          (if face-fun
+              (funcall face-fun (point) end)
+            (error "Face %s not configured for %s mode" face mode-name)))
+        ""))
+  (set (make-local-variable 'facemenu-remove-face-function) t)
+  (set (make-local-variable 'message-reply-headers) nil)
   (make-local-variable 'message-user-agent)
   (make-local-variable 'message-post-method)
   (set (make-local-variable 'message-sent-message-via) nil)
@@ -1854,9 +1845,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
        (mail-abbrevs-setup)
       (mail-aliases-setup)))
   (message-set-auto-save-file-name)
-  (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
-  (setq indent-tabs-mode nil)
-  (run-hooks 'text-mode-hook 'message-mode-hook))
+  (set (make-local-variable 'indent-tabs-mode) nil)) ;No tabs for indentation.
 
 (defun message-setup-fill-variables ()
   "Setup message fill variables."
@@ -2773,7 +2762,7 @@ It should typically alter the sending method in some way or other."
                                (format
                                 "Already sent message via %s; resend? "
                                 (car elem)))
-                            (error "Denied posting -- multiple copies.")))
+                            (error "Denied posting -- multiple copies")))
                       (setq success (funcall (caddr elem) arg)))
              (setq sent t)))))
       (unless (or sent (not success))
@@ -3459,17 +3448,23 @@ This sub function is for exclusive use of `message-send-news'."
                     (if followup-to
                         (concat newsgroups "," followup-to)
                       newsgroups)))
-           (hashtb (and (boundp 'gnus-active-hashtb)
-                        gnus-active-hashtb))
+            (known-groups
+             (mapcar '(lambda (n) (gnus-group-real-name n))
+                     (gnus-groups-from-server
+                      (cond ((equal gnus-post-method 'current)
+                             gnus-current-select-method)
+                            (gnus-post-method gnus-post-method)
+                            (t gnus-select-method)))))
            errors)
        (while groups
-        (when (and (not (boundp (intern (car groups) hashtb)))
-                   (not (equal (car groups) "poster")))
-          (push (car groups) errors))
-        (pop groups))
+         (unless (or (equal (car groups) "poster")
+                     (member (car groups) known-groups))
+           (push (car groups) errors))
+         (pop groups))
        (cond
        ;; Gnus is not running.
-       ((or (not hashtb)
+       ((or (not (and (boundp 'gnus-active-hashtb)
+                       gnus-active-hashtb))
             (not (boundp 'gnus-read-active-file)))
         t)
        ;; We don't have all the group names.
@@ -4335,12 +4330,12 @@ Headers already prepared in the buffer are not modified."
          (nthcdr (+ (- cut 2) surplus 1) list)))
 
 (defun message-shorten-references (header references)
-  "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+  "Trim REFERENCES to be 21 Message-ID long or less, and fold them.
 If folding is disallowed, also check that the REFERENCES are less
 than 988 characters long, and if they are not, trim them until they are."
-  (let ((maxcount 31)
+  (let ((maxcount 21)
        (count 0)
-       (cut 6)
+       (cut 2)
        refs)
     (with-temp-buffer
       (insert references)
@@ -5543,14 +5538,21 @@ which specify the range to operate on."
   "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
   "Regexp that match headers that lists groups.")
 
+(defvar message-completion-alist
+  (list (cons message-newgroups-header-regexp 'message-expand-group)
+       '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
+  "Alist of (RE . FUN).  Use FUN for completion on header lines matching RE.")
+
 (defun message-tab ()
   "Expand group names in Newsgroups and Followup-To headers.
 Do a `tab-to-tab-stop' if not in those headers."
   (interactive)
-  (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
-       (mail-abbrev-in-expansion-header-p))
-      (message-expand-group)
-    (tab-to-tab-stop)))
+  (let ((alist message-completion-alist))
+    (while (and alist
+               (let ((mail-abbrev-mode-regexp (caar alist)))
+                 (not (mail-abbrev-in-expansion-header-p))))
+      (setq alist (cdr alist)))
+    (funcall (or (cdar alist) (default-value 'indent-line-function)))))
 
 (defun message-expand-group ()
   "Expand the group name under point."
@@ -5594,6 +5596,11 @@ Do a `tab-to-tab-stop' if not in those headers."
            (goto-char (point-min))
            (delete-region (point) (progn (forward-line 3) (point))))))))))
 
+(defun message-expand-name ()
+  (if (fboundp 'bbdb-complete-name)
+      (bbdb-complete-name)
+    (expand-abbrev)))
+
 ;;; Help stuff.
 
 (defun message-talkative-question (ask question show &rest text)