1998-10-05 Katsumi Yamaoka <yamaoka@jpl.org>
[elisp/gnus.git-] / lisp / gnus-msg.el
index c1ed5b6..5f3c80a 100644 (file)
@@ -93,7 +93,7 @@ Thank you.
 The first %s will be replaced by the Newsgroups header;
 the second with the current group name.")
 
-(defvar gnus-message-setup-hook nil
+(defvar gnus-message-setup-hook '(message-maybe-setup-default-charset)
   "Hook run after setting up a message buffer.")
 
 (defvar gnus-bug-create-help-buffer t
@@ -191,8 +191,49 @@ Thank you for your help in stamping out bugs.
 
 (defun gnus-extended-version ()
   "Stringified gnus version."
-  (interactive) ; ???
-  (concat gnus-product-name "/" gnus-version-number))
+  (concat gnus-product-name "/" gnus-version-number " (based on "
+         gnus-original-product-name " " gnus-original-version-number ")"))
+
+(defun gnus-message-make-user-agent (&optional include-mime-info max-column)
+  "Return user-agent info.
+INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable
+  `mime-edit-user-agent-value' is exists, the return value will include it.
+MAX-COLUMN the optional second argument if it is specified, the return value
+  will be folded up in the proper way."
+  (let ((user-agent (if (and include-mime-info
+                            (boundp 'mime-edit-user-agent-value))
+                       (concat (gnus-extended-version)
+                               " "
+                               mime-edit-user-agent-value)
+                     (gnus-extended-version))))
+    (if max-column
+       (let (boundary)
+         (unless (natnump max-column) (setq max-column 76))
+         (with-temp-buffer
+           (insert "            " user-agent)
+           (goto-char 13)
+           (while (re-search-forward "[\n\t ]+" nil t)
+             (replace-match " "))
+           (goto-char 13)
+           (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t)
+             (while (eq ?\( (char-after (point)))
+               (forward-list)
+               (skip-chars-forward " "))
+             (skip-chars-backward " ")
+             (if (> (current-column) max-column)
+                 (progn
+                   (if (or (not boundary) (eq ?\n (char-after boundary)))
+                       (progn
+                         (setq boundary (point))
+                         (unless (eobp)
+                           (delete-char 1)
+                           (insert "\n ")))
+                     (goto-char boundary)
+                     (delete-char 1)
+                     (insert "\n ")))
+               (setq boundary (point))))
+           (buffer-substring 13 (point-max))))
+      user-agent)))
 
 (defvar gnus-article-reply nil)
 (defmacro gnus-setup-message (config &rest forms)
@@ -206,7 +247,8 @@ Thank you for your help in stamping out bugs.
           (,group gnus-newsgroup-name)
           (message-header-setup-hook
            (copy-sequence message-header-setup-hook))
-          (message-mode-hook (copy-sequence message-mode-hook)))
+          (message-mode-hook (copy-sequence message-mode-hook))
+          (gnus-message-get-reply-buffer 'gnus-copy-article-buffer))
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
        (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
@@ -255,12 +297,12 @@ If ARG is 1, prompt for a group name to find the posting style."
   (let ((gnus-newsgroup-name
         (if arg
             (if (= 1 (prefix-numeric-value arg))
-                (completing-read "Use style of group: " gnus-active-hashtb nil
+                (completing-read "Use posting style of group: "
+                                 gnus-active-hashtb nil
                                  (gnus-read-active-file-p))
               (gnus-group-group-name))
           "")))
-    (gnus-setup-message 'message (message-mail))
-    ))
+    (gnus-setup-message 'message (message-mail))))
 
 (defun gnus-group-post-news (&optional arg)
   "Start composing a news message.
@@ -383,10 +425,6 @@ header line with the old Message-ID."
   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
   ;; this buffer should be passed to all mail/news reply/post routines.
   (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
-  (buffer-disable-undo gnus-article-copy)
-  (save-excursion
-    (set-buffer gnus-article-copy)
-    (mm-enable-multibyte))
   (let ((article-buffer (or article-buffer gnus-article-buffer))
        end beg)
     (if (not (and (get-buffer article-buffer)
@@ -420,7 +458,7 @@ header line with the old Message-ID."
                         (or (search-forward "\n\n" nil t) (point)))
          ;; Insert the original article headers.
          (insert-buffer-substring gnus-original-article-buffer beg end)
-         (gnus-article-decode-rfc1522)))
+         (article-decode-encoded-words)))
       gnus-article-copy)))
 
 (defun gnus-post-news (post &optional group header article-buffer yank subject
@@ -516,14 +554,16 @@ If SILENT, don't prompt the user."
                   (list gnus-post-method)))
               gnus-secondary-select-methods
               (mapcar 'cdr gnus-server-alist)
+              (mapcar 'car gnus-opened-servers)
               (list gnus-select-method)
               (list group-method)))
             method-alist post-methods method)
        ;; Weed out all mail methods.
        (while methods
          (setq method (gnus-server-get-method "" (pop methods)))
-         (when (or (gnus-method-option-p method 'post)
-                   (gnus-method-option-p method 'post-mail))
+         (when (and (or (gnus-method-option-p method 'post)
+                        (gnus-method-option-p method 'post-mail))
+                    (not (member method post-methods)))
            (push method post-methods)))
        ;; Create a name-method alist.
        (setq method-alist
@@ -547,7 +587,7 @@ If SILENT, don't prompt the user."
      ((and (eq gnus-post-method 'current)
           (not (eq (car group-method) 'nndraft))
           (not arg))
-      group-method) 
+      group-method)
      ((and gnus-post-method
           (not (eq gnus-post-method 'current)))
       gnus-post-method)
@@ -571,8 +611,7 @@ automatically."
   ;; Stripping headers should be specified with mail-yank-ignored-headers.
   (when yank
     (gnus-summary-goto-subject (car yank)))
-  (let ((gnus-article-reply t)
-       (gnus-inhibit-posting-styles t))
+  (let ((gnus-article-reply t))
     (gnus-setup-message (if yank 'reply-yank 'reply)
       (gnus-summary-select-article)
       (set-buffer (gnus-copy-article-buffer))
@@ -692,7 +731,8 @@ The current group name will be inserted at \"%s\".")
        (gnus-summary-select-article)
        (set-buffer gnus-original-article-buffer)
        (if (and (<= (length (message-tokenize-header
-                             (setq newsgroups (mail-fetch-field "newsgroups"))
+                             (setq newsgroups
+                                   (mail-fetch-field "newsgroups"))
                              ", "))
                     1)
                 (or (not (setq followup-to (mail-fetch-field "followup-to")))
@@ -856,7 +896,6 @@ The source file has to be in the Emacs load path."
     ;; Go through all the files looking for non-default values for variables.
     (save-excursion
       (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
-      (buffer-disable-undo (current-buffer))
       (while files
        (erase-buffer)
        (when (and (setq file (locate-library (pop files)))
@@ -969,7 +1008,7 @@ this is a reply."
                       (concat "^" (regexp-quote mail-header-separator) "$")
                       nil t)
                  (replace-match "" t t ))
-               (unless (gnus-request-accept-article group method t)
+               (unless (gnus-request-accept-article group method t t)
                  (gnus-message 1 "Couldn't store article in group %s: %s"
                                group (gnus-status-message method))
                  (sit-for 2))
@@ -1000,7 +1039,7 @@ this is a reply."
          (and gnus-newsgroup-name
               (gnus-group-find-parameter
                gnus-newsgroup-name 'gcc-self)))
-        result 
+        result
         (groups
          (cond
           ((null gnus-message-archive-method)
@@ -1104,7 +1143,7 @@ this is a reply."
            (if (and (not (stringp (car attribute)))
                     (not (eq 'body (car attribute)))
                     (not (setq variable
-                               (cdr (assq (car attribute) 
+                               (cdr (assq (car attribute)
                                           gnus-posting-style-alist)))))
                (message "Couldn't find attribute %s" (car attribute))
              ;; We get the value.