2001-06-16 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>

	* message.el (message-check-news-header-syntax): Check Reply-To.

2001-06-16 08:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>

	* mml.el (mml-parse-1): Use message options.

	* message.el (message-do-fcc): Don't do anything if there is no
	FCC.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9775754..a8421c3 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2001-06-16 09:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+       * message.el (message-check-news-header-syntax): Check Reply-To.
+
+2001-06-16 08:00:00  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+       * mml.el (mml-parse-1): Use message options.
+
+       * message.el (message-do-fcc): Don't do anything if there is no
+       FCC.
+
 2001-06-16  Simon Josefsson  <jas@extundo.com>
 
        * nnimap.el (nnimap-split-articles): Support 'junk to-groups.

diff --git a/lisp/message.el b/lisp/message.el
index b07fc63..3f31a90 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -169,7 +169,7 @@ Checks include `subject-cmsg', `multiple-headers', `sendsys',
 `new-text', `quoting-style', `redirected-followup', `signature',
 `approved', `sender', `empty', `empty-headers', `message-id', `from',
 `subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
   :group 'message-news
   :type '(repeat sexp))                        ; Fixme: improve this
 
@@ -2972,6 +2972,32 @@ to find out how to use this."
           (message
            "Denied posting -- the From looks strange: \"%s\"." from)
           nil)
+         (t t))))
+     ;; Check the Reply-To header.
+     (message-check 'reply-to
+       (let* ((case-fold-search t)
+             (reply-to (message-fetch-field "reply-to"))
+             ad)
+        (cond
+          ((not reply-to)
+           t)
+          ((string-match "," reply-to)
+           (y-or-n-p
+            (format "Multiple Reply-To addresses: \"%s\". Really post? "
+                    reply-to)))
+         ((or (not (string-match
+                    "@[^\\.]*\\."
+                    (setq ad (nth 1 (mail-extract-address-components
+                                     reply-to))))) ;larsi@ifi
+              (string-match "\\.\\." ad) ;larsi@ifi..uio
+              (string-match "@\\." ad) ;larsi@.ifi.uio
+              (string-match "\\.$" ad) ;larsi@ifi.uio.
+              (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+              (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
+           (y-or-n-p
+            (format
+             "The Reply-To looks strange: \"%s\". Really post? " 
+             reply-to)))
          (t t))))))
 
 (defun message-check-news-body-syntax ()
@@ -3079,47 +3105,49 @@ to find out how to use this."
        (buf (current-buffer))
        list file)
     (save-excursion
-      (set-buffer (get-buffer-create " *message temp*"))
-      (erase-buffer)
-      (insert-buffer-substring buf)
       (save-restriction
        (message-narrow-to-headers)
-       (while (setq file (message-fetch-field "fcc"))
-         (push file list)
-         (message-remove-header "fcc" nil t)))
-      (message-encode-message-body)
-      (save-restriction
-       (message-narrow-to-headers)
-       (let ((mail-parse-charset message-default-charset)
-             (rfc2047-header-encoding-alist
-              (cons '("Newsgroups" . default)
-                    rfc2047-header-encoding-alist)))
-         (mail-encode-encoded-word-buffer)))
-      (goto-char (point-min))
-      (when (re-search-forward
-            (concat "^" (regexp-quote mail-header-separator) "$")
-            nil t)
-       (replace-match "" t t ))
-      ;; Process FCC operations.
-      (while list
-       (setq file (pop list))
-       (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
-           ;; Pipe the article to the program in question.
-           (call-process-region (point-min) (point-max) shell-file-name
-                                nil nil nil shell-command-switch
-                                (match-string 1 file))
-         ;; Save the article.
-         (setq file (expand-file-name file))
-         (unless (file-exists-p (file-name-directory file))
-           (make-directory (file-name-directory file) t))
-         (if (and message-fcc-handler-function
-                  (not (eq message-fcc-handler-function 'rmail-output)))
-             (funcall message-fcc-handler-function file)
-           (if (and (file-readable-p file) (mail-file-babyl-p file))
-               (rmail-output file 1 nil t)
-             (let ((mail-use-rfc822 t))
-               (rmail-output file 1 t t))))))
-      (kill-buffer (current-buffer)))))
+        (setq file (message-fetch-field "fcc" t)))
+      (when file
+        (set-buffer (get-buffer-create " *message temp*"))
+        (erase-buffer)
+        (insert-buffer-substring buf)
+        (message-encode-message-body)
+        (save-restriction
+          (message-narrow-to-headers)
+          (while (setq file (message-fetch-field "fcc" t))
+            (push file list)
+            (message-remove-header "fcc" nil t))
+          (let ((mail-parse-charset message-default-charset)
+                (rfc2047-header-encoding-alist
+                 (cons '("Newsgroups" . default)
+                       rfc2047-header-encoding-alist)))
+            (mail-encode-encoded-word-buffer)))
+        (goto-char (point-min))
+        (when (re-search-forward
+               (concat "^" (regexp-quote mail-header-separator) "$")
+               nil t)
+          (replace-match "" t t ))
+        ;; Process FCC operations.
+        (while list
+          (setq file (pop list))
+          (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+              ;; Pipe the article to the program in question.
+              (call-process-region (point-min) (point-max) shell-file-name
+                                   nil nil nil shell-command-switch
+                                   (match-string 1 file))
+            ;; Save the article.
+            (setq file (expand-file-name file))
+            (unless (file-exists-p (file-name-directory file))
+              (make-directory (file-name-directory file) t))
+            (if (and message-fcc-handler-function
+                     (not (eq message-fcc-handler-function 'rmail-output)))
+                (funcall message-fcc-handler-function file)
+              (if (and (file-readable-p file) (mail-file-babyl-p file))
+                  (rmail-output file 1 nil t)
+                (let ((mail-use-rfc822 t))
+                  (rmail-output file 1 t t))))))
+        (kill-buffer (current-buffer))))))
 
 (defun message-output (filename)
   "Append this article to Unix/babyl mail file FILENAME."

diff --git a/lisp/mml.el b/lisp/mml.el
index 4622a4d..ad1c450 100644 (file)
--- a/lisp/mml.el
+++ b/lisp/mml.el
@@ -125,14 +125,15 @@ one charsets.")
                         (mm-find-mime-charset-region point (point))))
        (when (and (not raw) (memq nil charsets))
          (if (or (memq 'unknown-encoding mml-confirmation-set)
-                 (prog1 (y-or-n-p
-                  "\
+                  (message-options-get 'unknown-encoding)
+                 (and (y-or-n-p "\
 Message contains characters with unknown encoding.  Really send?")
-                   (set (make-local-variable 'mml-confirmation-set)
-                        (push 'unknown-encoding mml-confirmation-set))))
+                       (message-options-set 'unknown-encoding t)))
              (if (setq use-ascii
                        (or (memq 'use-ascii mml-confirmation-set)
-                           (y-or-n-p "Use ASCII as charset?")))
+                            (message-options-get 'use-ascii)
+                           (and (y-or-n-p "Use ASCII as charset?")
+                                 (message-options-set 'use-ascii t))))
                  (setq charsets (delq nil charsets))
                (setq warn nil))
            (error "Edit your message to remove those characters")))
@@ -148,14 +149,11 @@ Message contains characters with unknown encoding.  Really send?")
                          tag point (point) use-ascii)))
            (when (and warn
                       (not (memq 'multipart mml-confirmation-set))
-                      (not
-                       (prog1 (y-or-n-p
-                               (format
-                                "\
+                       (not (message-options-get 'multipart))
+                      (not (and (y-or-n-p (format "\
 A message part needs to be split into %d charset parts.  Really send? "
-                                (length nstruct)))
-                         (set (make-local-variable 'mml-confirmation-set)
-                              (push 'multipart mml-confirmation-set)))))
+                                                   (length nstruct)))
+                                 (message-options-set 'multipart t))))
              (error "Edit your message to use only one charset"))
            (setq struct (nconc nstruct struct)))))))
     (unless (eobp)