From: okada <okada>
Date: Thu, 17 Jan 2002 09:23:52 +0000 (+0000)
Subject: * wl-vars.el (wl-message-id-use-wl-from): New variable.
X-Git-Tag: wl-2_9_5~7
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0b01e2387dc1820acb70475614a5593ea5ee323c;p=elisp%2Fwanderlust.git

* wl-vars.el (wl-message-id-use-wl-from): New variable.
* wl-utils.el (wl-draft-make-message-id-string):
Use `wl-from' for domain part of Message-ID
if `wl-message-id-use-wl-from' if non-nil.
* wl.el (wl-check-environment): Fix for `wl-message-id-use-wl-from'
---

diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi
index 9555fca..955b82d 100644
--- a/doc/wl-ja.texi
+++ b/doc/wl-ja.texi
@@ -4344,6 +4344,11 @@ Wanderlust のオフラインモード/オンラインモードをトグルします。
 初期設定は @code{t}。
 Non-nil なら、送信時に @samp{Message-ID:} フィールドを自動的に挿入します。
 
+@item wl-message-id-use-wl-from
+@vindex wl-message-id-use-wl-from
+初期設定は @code{nil}。Non-nil なら、@samp{Message-ID:} のドメインパートに 
+@code{wl-from} を利用します。
+
 @item wl-local-domain
 @vindex wl-local-domain
 初期設定は @code{nil}。@code{nil} ならば @samp{Message-ID:} のドメインパー
diff --git a/doc/wl.texi b/doc/wl.texi
index 2a9752d..0ffc6e0 100644
--- a/doc/wl.texi
+++ b/doc/wl.texi
@@ -4382,6 +4382,11 @@ draft buffer.  If @code{nil}, it is not automatically inserted.
 The initial setting is @code{t}.  If non-nil, @samp{Message-ID:} field
 is automatically inserted on the transmission.
 
+@item wl-message-id-use-wl-from
+@vindex wl-message-id-use-wl-from
+The initial setting is @code{nil}.  If non-nil, the value of
+@code{wl-from} will be used as the domain part of @samp{Message-ID:}.
+
 @item wl-local-domain
 @vindex wl-local-domain
 The initial setting is @code{nil}.  If @code{nil}, the return value of
diff --git a/samples/en/dot.wl b/samples/en/dot.wl
index 1fbf9c4..0cd00aa 100644
--- a/samples/en/dot.wl
+++ b/samples/en/dot.wl
@@ -54,6 +54,9 @@
 ;; Specific domain part for message-id.
 ;(setq wl-message-id-domain "hostname.example.com")
 
+;; Use wl-from for generating message-id.
+;; wl-message-id-use-wl-from precedes wl-local-domain and wl-message-id-domain.
+;(setq wl-message-id-use-wl-from t)
 
 ;;; [[ Server Setting ]]
 
diff --git a/samples/ja/dot.wl b/samples/ja/dot.wl
index 87c9b65..1f374fa 100644
--- a/samples/ja/dot.wl
+++ b/samples/ja/dot.wl
@@ -53,6 +53,10 @@
 ;; Message-ID のドメインパートを強制的に指定
 ;(setq wl-message-id-domain "hostname.example.com")
 
+;; Message-ID のドメインパートを wl-from から生成します。
+;; globalなIPを持たない場合に使ってください。
+;; wl-local-domain, wl-message-id-domainに優先します。
+;(setq wl-message-id-use-wl-from t)
 
 ;;; [[ サーバの設定 ]]
 
diff --git a/wl/ChangeLog b/wl/ChangeLog
index 96c2fc6..ddc58af 100644
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,5 +1,13 @@
 2002-01-17  Kenichi OKADA  <okada@opaopa.org>
 
+	* wl-vars.el (wl-message-id-use-wl-from): New variable.
+	* wl-utils.el (wl-draft-make-message-id-string):
+	Use `wl-from' for domain part of Message-ID
+	if `wl-message-id-use-wl-from' if non-nil.
+	* wl.el (wl-check-environment): Fix for `wl-message-id-use-wl-from'
+
+2002-01-17  Kenichi OKADA  <okada@opaopa.org>
+
 	* wl.el (wl): Call `wl-check-type'
 	Do not 'condition-case'.
 
diff --git a/wl/wl-util.el b/wl/wl-util.el
index 7a74af1..54d53a3 100644
--- a/wl/wl-util.el
+++ b/wl/wl-util.el
@@ -642,12 +642,20 @@ that `read' can handle, whenever this is possible."
 
 (defun wl-draft-make-message-id-string ()
   "Return Message-ID field value."
-  (concat "<" (wl-unique-id) "@"
-	  (or wl-message-id-domain
-	      (if wl-local-domain
-		  (concat (system-name) "." wl-local-domain)
-		(system-name)))
-	  ">"))
+  (concat "<" (wl-unique-id)
+	  (let (from user domain)
+	    (if (and wl-message-id-use-wl-from
+		     (progn
+		       (setq from (wl-address-header-extract-address wl-from))
+		       (and (string-match "^\\(.*\\)@\\(.*\\)$" from)
+			    (setq user   (match-string 1 from))
+			    (setq domain (match-string 2 from)))))
+		(format "%%%s@%s>" user domain)
+	      (format "@%s>"
+		      (or wl-message-id-domain
+			  (if wl-local-domain
+			      (concat (system-name) "." wl-local-domain)
+			    (system-name))))))))
 
 ;;; Profile loading.
 (defvar wl-load-profile-function 'wl-local-load-profile)
diff --git a/wl/wl-vars.el b/wl/wl-vars.el
index b24d7cc..9ad4af2 100644
--- a/wl/wl-vars.el
+++ b/wl/wl-vars.el
@@ -1166,6 +1166,11 @@ Allowed situations are:
   :group 'wl-summary
   :group 'wl-pref)
 
+(defcustom wl-message-id-use-wl-from nil
+  "*Use `wl-from' for domain part of Message-ID if non-nil."
+  :type 'boolean
+  :group 'wl-pref)
+
 (defcustom wl-local-domain nil
   "*Domain part of this client (without hostname).
 Set this if (system-name) does not return FQDN."
diff --git a/wl/wl.el b/wl/wl.el
index ac52444..1dbe681 100644
--- a/wl/wl.el
+++ b/wl/wl.el
@@ -703,22 +703,25 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 (defun wl-check-environment (no-check-folder)
   (unless wl-from (error "Please set `wl-from'"))
   ;; Message-ID
-  (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain
-					  (if wl-local-domain
-					      (concat (system-name)
-						      "." wl-local-domain)
-					    (system-name))))
-    (error "Please set `wl-local-domain' to get valid FQDN"))
-  (if (string-match "@" (or wl-message-id-domain
-			    (if wl-local-domain
-				(concat (system-name)
-					"." wl-local-domain)
-			      (system-name))))
-      (error "Please remove `@' from `wl-message-id-domain'"))
-  (if (string= wl-local-domain "localdomain")
-      (error "Please set `wl-local-domain'"))
-  (if (string= wl-message-id-domain "localhost.localdomain")
-      (error "Please set `wl-message-id-domain'"))
+  (let ((from domain))
+    (if wl-message-id-use-wl-from
+	(if (and (setq from (wl-address-header-extract-address wl-from))
+		 (string-match "^\\(.*\\)@\\(.*\\)$" from))
+	    (setq domain (match-string 2 from))
+	  (error "Please set `wl-from' to get valid Message-ID string."))
+      (setq domain
+	    (or wl-message-id-domain
+		(if wl-local-domain
+		    (concat (system-name) "." wl-local-domain)
+		  (system-name)))))
+    (unless (string-match "[^.]\\.[^.]" domain)
+      (error "Please set `wl-local-domain' to get valid FQDN"))
+    (if (string-match "@" domain)
+	(error "Please remove `@' from `wl-message-id-domain'"))
+    (if (string= wl-local-domain "localdomain")
+	(error "Please set `wl-local-domain'"))
+    (if (string= wl-message-id-domain "localhost.localdomain")
+	(error "Please set `wl-message-id-domain'")))
   ;; folders
   (when (not no-check-folder)
     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))