* wl.el (wl-check-environment): Undo last change.
[elisp/wanderlust.git] / wl / wl-draft.el
index f8db10f..3a6b4a9 100644 (file)
@@ -1,8 +1,10 @@
 ;;; wl-draft.el -- Message draft mode for Wanderlust.
 
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;;     Masahiro MURATA <muse@ba2.so-net.ne.jp>
 ;; Keywords: mail, net news
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
 (defvar x-face-add-x-face-version-header)
 (defvar mail-reply-buffer)
 (defvar mail-from-style)
-(defvar smtp-authenticate-type)
-(defvar smtp-authenticate-user)
-(defvar smtp-authenticate-passphrase)
-(defvar smtp-connection-type)
 
 (eval-when-compile
   (require 'elmo-pop3)
 (make-variable-buffer-local 'wl-draft-fcc-list)
 (make-variable-buffer-local 'wl-draft-reply-buffer)
 
-;;; SMTP binding by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-(defvar wl-smtp-features
-  '(((smtp-authenticate-type
-      (if wl-smtp-authenticate-type
-         (intern (downcase (format "%s" wl-smtp-authenticate-type)))))
-     ((smtp-authenticate-user wl-smtp-posting-user)
-      ((smtp-authenticate-passphrase
-       (elmo-get-passwd
-        (format "%s@%s"
-                smtp-authenticate-user
-                smtp-server))))))
-    (smtp-connection-type))
-  "Additional SMTP features.")
-
-(eval-when-compile
-  (defun wl-smtp-parse-extension (exts parents)
-    (let (bindings binding feature)
-      (dolist (ext exts)
-       (setq feature (if (listp (car ext)) (caar ext) (car ext))
-             binding
-             (` ((, feature)
-                 (or (, (if (listp (car ext))
-                            (cadar ext)
-                          (let ((wl-feature
-                                 (intern
-                                  (concat "wl-" (symbol-name feature)))))
-                            (if (boundp wl-feature)
-                                wl-feature))))
-                     (and (boundp '(, feature)) (, feature))))))
-       (when parents
-         (setcdr binding (list (append '(and) parents (cdr binding)))))
-       (setq bindings
-             (nconc bindings (list binding)
-                    (wl-smtp-parse-extension
-                     (cdr ext) (cons feature parents)))))
-      bindings)))
-
 (defmacro wl-smtp-extension-bind (&rest body)
-  "Return a `let' form that binds all variables of SMTP extension.
-After this is done, BODY will be executed in the scope
-of the `let' form.
-
-The variables bound and their default values are described by
-the `wl-smtp-features' variable."
-  (` (let* (, (wl-smtp-parse-extension wl-smtp-features nil))
+  (` (let* ((smtp-sasl-mechanisms
+            (if wl-smtp-authenticate-type
+                (mapcar 'upcase
+                        (if (listp wl-smtp-authenticate-type)
+                            wl-smtp-authenticate-type
+                          (list wl-smtp-authenticate-type)))))
+           (smtp-use-sasl (and smtp-sasl-mechanisms t))
+           (smtp-use-starttls (eq wl-smtp-connection-type 'starttls))
+           smtp-sasl-user-name smtp-sasl-properties sasl-read-passphrase)
+       (if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5")
+               ;; sendmail bug?
+               (string-match "^\\([^@]*\\)@\\([^@]*\\)"
+                             wl-smtp-posting-user))
+          (setq smtp-sasl-user-name (match-string 1 wl-smtp-posting-user)
+                smtp-sasl-properties (list 'realm 
+                                           (match-string 2 wl-smtp-posting-user)))
+        (setq smtp-sasl-user-name wl-smtp-posting-user
+              smtp-sasl-properties nil))
+       (setq sasl-read-passphrase
+            (function
+             (lambda (prompt)
+               (elmo-get-passwd
+                (format "%s@%s"
+                        smtp-sasl-user-name
+                        smtp-server)))))
        (,@ body))))
 
 (defun wl-draft-insert-date-field ()
@@ -153,7 +132,7 @@ the `wl-smtp-features' variable."
         (fullname (user-full-name)))
     (cond ((eq mail-from-style 'angles)
           (insert "From: " fullname)
-          (let ((fullname-start (+ (point-min) 6))
+          (let ((fullname-start (+ (point-min) (length "From: ")))
                 (fullname-end (point-marker)))
             (goto-char fullname-start)
             ;; Look for a character that cannot appear unquoted
@@ -189,33 +168,33 @@ the `wl-smtp-features' variable."
                 (replace-match "\\1(\\3)" t)
                 (goto-char fullname-start))))
           (insert ")\n"))
-         ((null mail-from-style)
+         ((not mail-from-style)
           (insert "From: " login "\n")))))
 
 (defun wl-draft-insert-x-face-field ()
-  "Insert x-face header."
+  "Insert X-Face header."
   (interactive)
-  (if (not (file-exists-p wl-x-face-file))
-      (error "File %s does not exist" wl-x-face-file)
-    (beginning-of-buffer)
-    (search-forward mail-header-separator nil t)
-    (beginning-of-line)
-    (wl-draft-insert-x-face-field-here)
-    (run-hooks 'wl-draft-insert-x-face-field-hook) ; highlight it if you want.
-    ))
+  (unless (file-exists-p wl-x-face-file)
+    (error "File %s does not exist" wl-x-face-file))
+  (beginning-of-buffer)
+  (search-forward mail-header-separator nil t)
+  (beginning-of-line)
+  (wl-draft-insert-x-face-field-here)
+  (run-hooks 'wl-draft-insert-x-face-field-hook)) ; highlight it if you want.
 
 (defun wl-draft-insert-x-face-field-here ()
-  "Insert x-face field at point."
+  "Insert X-Face field at point."
   (let ((x-face-string (elmo-get-file-string wl-x-face-file)))
-    (if (string-match "^[ \t]*" x-face-string)
-       (setq x-face-string (substring x-face-string (match-end 0))))
+    (when (string-match "^[ \t]*" x-face-string)
+      (setq x-face-string (substring x-face-string (match-end 0))))
     (insert "X-Face: " x-face-string))
-  (if (not (= (preceding-char) ?\n))
-      (insert ?\n))
-  (and (fboundp 'x-face-insert-version-header) ; x-face.el...
-       (boundp 'x-face-add-x-face-version-header)
-       x-face-add-x-face-version-header
-       (x-face-insert-version-header)))
+  (when (not (= (preceding-char) ?\n)) ; for chomped (choped) x-face-string
+    (insert ?\n))
+  ;; Insert X-Face-Version: field
+  (when (and (fboundp 'x-face-insert-version-header)
+            (boundp 'x-face-add-x-face-version-header)
+            x-face-add-x-face-version-header)
+    (x-face-insert-version-header)))
 
 (defun wl-draft-setup ()
   (let ((field wl-draft-fields)
@@ -246,16 +225,12 @@ the `wl-smtp-features' variable."
 (defun wl-draft-delete-myself-from-cc (to cc)
   (let ((myself (or wl-user-mail-address-list
                    (list (wl-address-header-extract-address wl-from)))))
-    (if wl-draft-always-delete-myself
-       (elmo-list-delete myself cc)
-      (if (elmo-list-member myself cc)
-         (if (elmo-list-member (append to cc)
-                               (mapcar 'downcase wl-subscribed-mailing-list))
-             ;; member list is contained in recipients.
-             (elmo-list-delete myself cc)
-           cc
-           )
-       cc))))
+    (cond (wl-draft-always-delete-myself ; always-delete option
+          (elmo-list-delete myself cc))
+         ((elmo-list-member (append to cc) ; subscribed mailing-list
+                            (mapcar 'downcase wl-subscribed-mailing-list))
+          (elmo-list-delete myself cc))
+         (t cc))))
 
 (defun wl-draft-forward (original-subject summary-buf)
   (let (references)
@@ -267,35 +242,40 @@ the `wl-smtp-features' variable."
            references (mapconcat 'identity references " ")
            references (wl-draft-parse-msg-id-list-string references)
            references (wl-delete-duplicates references)
-           references (if references
-                          (mapconcat 'identity references "\n\t"))))
+           references (when references
+                        (mapconcat 'identity references "\n\t"))))
     (wl-draft "" (concat "Forward: " original-subject)
              nil nil references nil nil nil nil nil nil summary-buf))
   (goto-char (point-max))
   (wl-draft-insert-message)
   (mail-position-on-field "To"))
 
-(defun wl-draft-reply (buf no-arg summary-buf)
-  ""
+(defun wl-draft-strip-subject-re (subject)
+  "Remove \"Re:\" from subject lines. Shamelessly copied from Gnus"
+  (if (string-match wl-subject-prefix-regexp subject)
+      (substring subject (match-end 0))
+    subject))
+
+(defun wl-draft-reply-list-symbol (with-arg)
+  "Return symbol `wl-draft-reply-*-argument-list' match condition.
+Check WITH-ARG and From: field."
+  (if (wl-address-user-mail-address-p (or (elmo-field-body "From") ""))
+      (if with-arg
+         'wl-draft-reply-myself-with-argument-list
+       'wl-draft-reply-myself-without-argument-list)
+    (if with-arg
+       'wl-draft-reply-with-argument-list
+      'wl-draft-reply-without-argument-list)))
+
+(defun wl-draft-reply (buf with-arg summary-buf)
+  "Reply to BUF buffer message.
+Reply to author if WITH-ARG is non-nil."
 ;;;(save-excursion
   (let (r-list
-       (eword-lexical-analyzer '(eword-analyze-quoted-string
-                                 eword-analyze-domain-literal
-                                 eword-analyze-comment
-                                 eword-analyze-spaces
-                                 eword-analyze-special
-                                 eword-analyze-encoded-word
-                                 eword-analyze-atom))
        to mail-followup-to cc subject in-reply-to references newsgroups
-       from to-alist cc-alist)
+       from to-alist cc-alist decoder)
     (set-buffer buf)
-    (setq from (wl-address-header-extract-address (std11-field-body "From")))
-    (setq r-list 
-         (if (wl-address-user-mail-address-p from)
-             (if no-arg wl-draft-reply-myself-without-argument-list
-               wl-draft-reply-myself-with-argument-list)
-           (if no-arg wl-draft-reply-without-argument-list
-             wl-draft-reply-with-argument-list)))
+    (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
     (catch 'done
       (while r-list
        (when (let ((condition (car (car r-list))))
@@ -331,47 +311,34 @@ the `wl-smtp-features' variable."
                                             ",")))
          (throw 'done nil))
        (setq r-list (cdr r-list)))
-      (error "No match field: check your `wl-draft-reply-without-argument-list'"))
+      (error "No match field: check your `%s'"
+            (symbol-name (wl-draft-reply-list-symbol with-arg))))
     (setq subject (std11-field-body "Subject"))
     (setq to (wl-parse-addresses to)
          cc (wl-parse-addresses cc))
     (with-temp-buffer                  ; to keep raw buffer unibyte.
       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-      (setq subject (or (and subject
-                            (eword-decode-string
-                             (decode-mime-charset-string
-                              subject
-                              wl-mime-charset)))))
+      (setq decoder (mime-find-field-decoder 'Subject 'plain))
+      (setq subject (if (and subject decoder)
+                       (funcall decoder subject) subject))
       (setq to-alist 
            (mapcar
-            '(lambda (addr)
-               (setq addr (eword-extract-address-components addr))
-               (cons (nth 1 addr)
-                     (if (nth 0 addr)
-                         (concat
-                          (wl-address-quote-specials (nth 0 addr))
-                          " <" (nth 1 addr) ">")
-                       (nth 1 addr))))
+            (lambda (addr)
+              (setq decoder (mime-find-field-decoder 'To 'plain))
+              (cons (nth 1 (std11-extract-address-components addr))
+                    (if decoder (funcall decoder addr) addr)))
             to))
       (setq cc-alist 
            (mapcar
-            '(lambda (addr)
-               (setq addr (eword-extract-address-components addr))
-               (cons (nth 1 addr)
-                     (if (nth 0 addr)
-                         (concat
-                          (wl-address-quote-specials (nth 0 addr))
-                          " <" (nth 1 addr) ">")
-                       (nth 1 addr))))
+            (lambda (addr)
+              (setq decoder (mime-find-field-decoder 'Cc 'plain))
+              (cons (nth 1 (std11-extract-address-components addr))
+                    (if decoder (funcall decoder addr) addr)))
             cc)))
-    (and subject wl-reply-subject-prefix
-        (let ((case-fold-search t))
-          (not
-           (equal
-            (string-match (regexp-quote wl-reply-subject-prefix)
-                          subject)
-            0)))
-        (setq subject (concat wl-reply-subject-prefix subject)))
+    (and wl-reply-subject-prefix
+        (setq subject (concat wl-reply-subject-prefix
+                               (wl-draft-strip-subject-re
+                               (or subject "")))))
     (setq in-reply-to (std11-field-body "Message-Id"))
     (setq references (nconc
                      (std11-field-bodies '("References" "In-Reply-To"))
@@ -382,12 +349,10 @@ the `wl-smtp-features' variable."
     ;; and myself is contained in cc,
     ;; delete myself from cc.
     (setq cc (wl-draft-delete-myself-from-cc to cc))
-    (if wl-insert-mail-followup-to
-       (progn
-         (setq mail-followup-to
-               (wl-draft-make-mail-followup-to (append to cc)))
-         (setq mail-followup-to (wl-delete-duplicates mail-followup-to
-                                                      nil t))))
+    (when wl-insert-mail-followup-to
+      (setq mail-followup-to
+           (wl-draft-make-mail-followup-to (append to cc)))
+      (setq mail-followup-to (wl-delete-duplicates mail-followup-to nil t)))
     (setq newsgroups (wl-parse newsgroups
                               "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
          newsgroups (wl-delete-duplicates newsgroups)
@@ -441,9 +406,9 @@ the `wl-smtp-features' variable."
         (setq ref-list
               (cons (substring ref (match-beginning 0) (setq st (match-end 0)))
                     ref-list)))
-      (if (and ref-list
-               (member mes-id ref-list))
-          (setq mes-id nil)))
+      (when (and ref-list
+                (member mes-id ref-list))
+       (setq mes-id nil)))
     (when mes-id
       (save-excursion
         (when (mail-position-on-field "References")
@@ -462,9 +427,9 @@ the `wl-smtp-features' variable."
     (insert
      (save-excursion
        (set-buffer mail-reply-buffer)
-       (if decode-it
-          (decode-mime-charset-region (point-min) (point-max)
-                                      wl-mime-charset))
+       (when decode-it
+        (decode-mime-charset-region (point-min) (point-max)
+                                    wl-mime-charset))
        (buffer-substring-no-properties
        (point-min) (point-max))))
     (when ignored-fields
@@ -479,23 +444,20 @@ the `wl-smtp-features' variable."
          (t (and wl-draft-cite-func
                  (funcall wl-draft-cite-func)))) ; default cite
     (run-hooks 'wl-draft-cited-hook)
-    (and wl-draft-add-references
-        (if (wl-draft-add-references)
-            (wl-highlight-headers 'for-draft)))
-    (if wl-highlight-body-too
-       (wl-highlight-body-region beg (point-max)))))
+    (when (and wl-draft-add-references
+              (wl-draft-add-references))
+      (wl-highlight-headers 'for-draft)) ; highlight when added References:
+    (when wl-highlight-body-too
+      (wl-highlight-body-region beg (point-max)))))
 
 (defun wl-draft-confirm ()
   "Confirm send message."
   (interactive)
-  (y-or-n-p (format "Send current draft as %s? "
-                   (if (wl-message-mail-p)
-                       (if (wl-message-news-p) "Mail and News" "Mail")
-                     "News"))))
-
-(defun wl-message-news-p ()
-  "If exist valid Newsgroups field, return non-nil."
-  (std11-field-body "Newsgroups"))
+  (y-or-n-p
+   (cond ((and (wl-message-mail-p) (wl-message-news-p))
+         "Send current draft as Mail and News? ")
+        ((wl-message-mail-p) "Send current draft as Mail? ")
+        ((wl-message-news-p) "Send current draft as News? "))))
 
 (defun wl-message-field-exists-p (field)
   "If FIELD exist and FIELD value is not empty, return non-nil."
@@ -503,9 +465,14 @@ the `wl-smtp-features' variable."
     (and value
         (not (string= value "")))))
 
+(defun wl-message-news-p ()
+  "If exist valid Newsgroups field, return non-nil."
+  (std11-field-body "Newsgroups"))
+
 (defun wl-message-mail-p ()
   "If exist To, Cc or Bcc field, return non-nil."
   (or (wl-message-field-exists-p "To")
+      (wl-message-field-exists-p "Resent-to")      
       (wl-message-field-exists-p "Cc")
       (wl-message-field-exists-p "Bcc")
 ;;; This may be needed..
@@ -525,9 +492,8 @@ the `wl-smtp-features' variable."
   (let ((cur-buf (current-buffer))
        (tmp-buf (get-buffer-create " *wl-draft-edit-string*"))
        to subject in-reply-to cc references newsgroups mail-followup-to
-       content-type content-transfer-encoding
-       body-beg buffer-read-only
-       )
+       content-type content-transfer-encoding from
+       body-beg buffer-read-only)
     (set-buffer tmp-buf)
     (erase-buffer)
     (insert string)
@@ -543,6 +509,12 @@ the `wl-smtp-features' variable."
                        (decode-mime-charset-string
                         subject
                         wl-mime-charset))))
+    (setq from (std11-field-body "From")
+         from (and from
+                   (eword-decode-string
+                    (decode-mime-charset-string
+                     from
+                     wl-mime-charset))))    
     (setq in-reply-to (std11-field-body "In-Reply-To"))
     (setq cc (std11-field-body "Cc"))
     (setq cc (and cc
@@ -564,8 +536,10 @@ the `wl-smtp-features' variable."
                   mail-followup-to
                   content-type content-transfer-encoding
                   (buffer-substring (point) (point-max))
-                  'edit-again
-                  ))
+                  'edit-again nil
+                  (if (member (nth 1 (std11-extract-address-components from))
+                              wl-user-mail-address-list)
+                      from)))
       (and to (mail-position-on-field "To"))
       (delete-other-windows)
       (kill-buffer tmp-buf)))
@@ -577,10 +551,9 @@ the `wl-smtp-features' variable."
   (let ((mail-reply-buffer (wl-message-get-original-buffer))
        mail-citation-hook mail-yank-hooks
        wl-draft-add-references wl-draft-cite-func)
-    (if (eq 0
-           (save-excursion
-             (set-buffer mail-reply-buffer)
-             (buffer-size)))
+    (if (zerop
+        (with-current-buffer mail-reply-buffer
+          (buffer-size)))
        (error "No current message")
       (wl-draft-yank-from-mail-reply-buffer nil
                                            wl-ignored-forwarded-headers))))
@@ -706,7 +679,7 @@ the `wl-smtp-features' variable."
            (let ((msg (and wl-draft-buffer-file-name
                            (string-match "[0-9]+$" wl-draft-buffer-file-name)
                            (string-to-int
-                            (elmo-match-string 0 wl-draft-buffer-file-name)))))
+                            (match-string 0 wl-draft-buffer-file-name)))))
              (wl-draft-config-info-operation msg 'delete))))
       (set-buffer-modified-p nil)              ; force kill
       (kill-buffer editing-buffer))))
@@ -725,11 +698,11 @@ the `wl-smtp-features' variable."
     (message "")))
 
 (defun wl-draft-fcc ()
-  "Add a new FCC field, with file name completion."
+  "Add a new Fcc field, with file name completion."
   (interactive)
-  (or (mail-position-on-field "fcc" t)  ;Put new field after exiting FCC.
+  (or (mail-position-on-field "fcc" t)  ;Put new field after exiting Fcc.
       (mail-position-on-field "to"))
-  (insert "\nFCC: "))
+  (insert "\nFcc: "))
 
 ;; function for wl-sent-message-via
 
@@ -832,20 +805,11 @@ to find out how to use this."
 
 (defun wl-draft-parse-msg-id-list-string (string)
   "Get msg-id list from STRING."
-  (let ((parsed (std11-parse-msg-ids-string string))
-       tokens msg-id msg-id-list)
-    (while parsed
-      (setq msg-id nil)
-      (when (eq (car (car parsed)) 'msg-id)
-       (setq tokens (cdr (car parsed)))
-       (while tokens
-         (if (or (eq (car (car tokens)) 'atom)
-                 (eq (car (car tokens)) 'specials))
-             (setq msg-id (concat msg-id (cdr (car tokens)))))
-         (setq tokens (cdr tokens))))
-      (if msg-id (setq msg-id-list (cons (concat "<" msg-id ">")
-                                        msg-id-list)))
-      (setq parsed (cdr parsed)))
+  (let (msg-id-list)
+    (dolist (parsed-id (std11-parse-msg-ids-string string))
+      (when (eq (car parsed-id) 'msg-id)
+       (setq msg-id-list (cons (std11-msg-id-string parsed-id)
+                               msg-id-list))))
     (nreverse msg-id-list)))
 
 (defun wl-draft-parse-mailbox-list (field &optional remove-group-list)
@@ -976,12 +940,12 @@ non-nil."
              (as-binary-process
               (when recipients
                 (wl-smtp-extension-bind
-                 (let ((err (smtp-via-smtp sender recipients
-                                           (current-buffer))))
-                   (when (not (eq err t))
-                     (wl-draft-write-sendlog 'failed 'smtp smtp-server
-                                             recipients id)
-                     (error "Sending failed; SMTP protocol error:%s" err))))
+                 (condition-case err
+                     (smtp-send-buffer sender recipients (current-buffer))
+                   (error
+                    (wl-draft-write-sendlog 'failed 'smtp smtp-server
+                                            recipients id)
+                    (signal (car err) (cdr err)))))
                 (wl-draft-set-sent-message 'mail 'sent)
                 (wl-draft-write-sendlog
                  'ok 'smtp smtp-server recipients id)))))
@@ -992,18 +956,19 @@ non-nil."
   "Send the prepared message buffer with POP-before-SMTP."
   (require 'elmo-pop3)
   (condition-case ()
-      (elmo-pop3-get-session
-       (list 'pop3
-            (or wl-pop-before-smtp-user
-                elmo-default-pop3-user)
-            (or wl-pop-before-smtp-authenticate-type
-                elmo-default-pop3-authenticate-type)
-            (or wl-pop-before-smtp-server
-                elmo-default-pop3-server)
-            (or wl-pop-before-smtp-port
-                elmo-default-pop3-port)
-            (or wl-pop-before-smtp-stream-type
-                elmo-default-pop3-stream-type)))
+      (let ((session (elmo-pop3-get-session
+                     (list 'pop3
+                           (or wl-pop-before-smtp-user
+                               elmo-default-pop3-user)
+                           (or wl-pop-before-smtp-authenticate-type
+                               elmo-default-pop3-authenticate-type)
+                           (or wl-pop-before-smtp-server
+                               elmo-default-pop3-server)
+                           (or wl-pop-before-smtp-port
+                               elmo-default-pop3-port)
+                           (or wl-pop-before-smtp-stream-type
+                               elmo-default-pop3-stream-type)))))
+       (when session (elmo-network-close-session session)))
     (error))
   (wl-draft-send-mail-with-smtp))
 
@@ -1075,11 +1040,11 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
        (if (and sent-via wl-draft-fcc-list)
            (progn
              (wl-draft-do-fcc (wl-draft-get-header-delimiter) wl-draft-fcc-list)
-             (setq wl-draft-fcc-list nil))
-         (if wl-draft-use-cache
-             (let ((id (std11-field-body "Message-ID"))
-                   (elmo-enable-disconnected-operation t))
-               (elmo-cache-save id nil nil nil))))
+             (setq wl-draft-fcc-list nil)))
+       (if wl-draft-use-cache
+           (let ((id (std11-field-body "Message-ID"))
+                 (elmo-enable-disconnected-operation t))
+             (elmo-cache-save id nil nil nil)))
        ;; If one unplugged, append queue.
        (when (and unplugged-via
                   wl-sent-message-modified)
@@ -1126,7 +1091,9 @@ If FORCE-MSGID, ignore 'wl-insert-message-id'."
   "Send current draft message.
 If optional argument is non-nil, current draft buffer is killed"
   (interactive)
-  (wl-draft-config-exec)
+  ;; Don't call this explicitly.
+  ;; Added to 'wl-draft-send-hook (by teranisi)
+  ;; (wl-draft-config-exec)
   (run-hooks 'wl-draft-send-hook)
   (when (or (not wl-interactive-send)
            (y-or-n-p "Send current draft. OK?"))
@@ -1173,7 +1140,7 @@ If optional argument is non-nil, current draft buffer is killed"
   (wl-draft-config-info-operation
    (and (string-match "[0-9]+$" wl-draft-buffer-file-name)
        (string-to-int
-        (elmo-match-string 0 wl-draft-buffer-file-name)))
+        (match-string 0 wl-draft-buffer-file-name)))
    'save))
 
 (defun wl-draft-mimic-kill-buffer ()
@@ -1241,7 +1208,7 @@ If optional argument is non-nil, current draft buffer is killed"
     (or (markerp header-end) (error "header-end must be a marker"))
     (save-excursion
       (goto-char (point-min))
-      (while (re-search-forward "^FCC:[ \t]*" header-end t)
+      (while (re-search-forward "^Fcc:[ \t]*" header-end t)
        (setq fcc-list
              (cons (buffer-substring-no-properties
                     (point)
@@ -1311,15 +1278,11 @@ If optional argument is non-nil, current draft buffer is killed"
                nil
              (if (re-search-forward ":" pos t) nil t)))))))
 
-(defun wl-draft-random-alphabet ()
-  (let ((alphabet '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z)))
-    (nth (abs (% (random) 26)) alphabet)))
-
 ;;;###autoload
 (defun wl-draft (&optional to subject in-reply-to cc references newsgroups
                           mail-followup-to
                           content-type content-transfer-encoding
-                          body edit-again summary-buf)
+                          body edit-again summary-buf from)
   "Write and send mail/news message with Wanderlust."
   (interactive)
   (unless (featurep 'wl)
@@ -1352,13 +1315,13 @@ If optional argument is non-nil, current draft buffer is killed"
     (if (or (eq wl-draft-reply-buffer-style 'full)
            (eq this-command 'wl-draft)
            (eq this-command 'wl-summary-write)
-           (eq this-command 'wl-summary-write-current-newsgroup))
+           (eq this-command 'wl-summary-write-current-folder))
        (delete-other-windows))
     (auto-save-mode -1)
     (wl-draft-mode)
     (setq wl-sent-message-via nil)
-    (if (stringp wl-from)
-       (insert "From: " wl-from "\n"))
+    (if (stringp (or from wl-from))
+       (insert "From: " (or from wl-from) "\n"))
     (and (or (interactive-p)
             (eq this-command 'wl-summary-write)
             to)
@@ -1378,10 +1341,9 @@ If optional argument is non-nil, current draft buffer is killed"
     (setq wl-draft-buffer-file-name file-name)
     (if mail-default-reply-to
        (insert "Reply-To: " mail-default-reply-to "\n"))
-    (if (or wl-bcc mail-self-blind)
-       (insert "Bcc: " (or wl-bcc (user-login-name)) "\n"))
-    (if wl-fcc
-       (insert "FCC: " (if (functionp wl-fcc) (funcall wl-fcc) wl-fcc) "\n"))
+    (wl-draft-insert-ccs "Bcc: " (or wl-bcc
+                              (and mail-self-blind (user-login-name))))
+    (wl-draft-insert-ccs "Fcc: " wl-fcc)
     (if wl-organization
        (insert "Organization: " wl-organization "\n"))
     (and wl-auto-insert-x-face
@@ -1397,7 +1359,7 @@ If optional argument is non-nil, current draft buffer is killed"
          (when content-type
            (insert "Content-type: " content-type "\n"))
          (when content-transfer-encoding
-           (insert "Content-Transfer-encoding: " content-transfer-encoding "\n"))
+           (insert "Content-Transfer-Encoding: " content-transfer-encoding "\n"))
          (if (or content-type content-transfer-encoding)
              (insert "\n"))
          (and body (insert body))
@@ -1418,9 +1380,6 @@ If optional argument is non-nil, current draft buffer is killed"
                           (1- (point)))
                         'category 'mail-header-separator)
       (and body (insert body)))
-    (if wl-on-nemacs
-       (push-mark (point) t)
-      (push-mark (point) t t))
     (as-binary-output-file
      (write-region (point-min)(point-max) wl-draft-buffer-file-name
                   nil t))
@@ -1428,6 +1387,7 @@ If optional argument is non-nil, current draft buffer is killed"
     (wl-draft-overload-functions)
     (wl-highlight-headers 'for-draft)
     (goto-char (point-min))
+    (setq wl-draft-config-exec-flag t)
     (if (interactive-p)
        (run-hooks 'wl-mail-setup-hook))
     (wl-user-agent-compose-internal) ;; user-agent
@@ -1437,12 +1397,26 @@ If optional argument is non-nil, current draft buffer is killed"
           (mail-position-on-field "To"))
          (t
           (goto-char (point-max))))
-    (setq wl-draft-config-exec-flag t)
     (setq wl-draft-buffer-cur-summary-buffer (or summary-buf
                                                 (get-buffer
                                                  wl-summary-buffer-name)))
     buf-name))
 
+(defsubst wl-draft-insert-ccs (str cc)
+  (let ((field
+        (if (functionp cc)
+            (funcall cc)
+          cc)))
+    (if (and field
+            (null (and wl-draft-delete-myself-from-bcc-fcc
+                       (elmo-list-member
+                        (mapcar 'wl-address-header-extract-address
+                                (append
+                                 (wl-parse-addresses (std11-field-body "To"))
+                                 (wl-parse-addresses (std11-field-body "Cc"))))
+                        (mapcar 'downcase wl-subscribed-mailing-list)))))
+       (insert str field "\n"))))
+
 (defun wl-draft-elmo-nntp-send ()
   (let ((elmo-nntp-post-pre-hook wl-news-send-pre-hook)
        (elmo-default-nntp-user
@@ -1509,9 +1483,6 @@ If optional argument is non-nil, current draft buffer is killed"
     (goto-char (point-min))
     (or (re-search-forward "\n\n" nil t)
        (search-forward (concat mail-header-separator "\n") nil t))
-    (if wl-on-nemacs
-       (push-mark (point) t)
-      (push-mark (point) t t))
     (write-region (point-min)(point-max) wl-draft-buffer-file-name
                  nil t)
     (wl-draft-overload-functions)