Backport changes:
[elisp/wanderlust.git] / wl / wl-draft.el
index f1fe90a..a13f870 100644 (file)
@@ -81,7 +81,7 @@ This variable is local in each draft buffer.
 You can refer its value in `wl-draft-config-alist'.
 
 e.g.
-(setq wl-draft-config-alist
+\(setq wl-draft-config-alist
       '(((string-match \".*@domain1$\" wl-draft-parent-folder)
          (\"From\" . \"user@domain1\"))
         ((string-match \".*@domain2$\" wl-draft-parent-folder)
@@ -295,6 +295,9 @@ e.g.
            references (wl-delete-duplicates references)
            references (when references
                         (mapconcat 'identity references "\n\t"))))
+    (and wl-draft-use-frame
+        (get-buffer-window summary-buf)
+        (select-window (get-buffer-window summary-buf)))
     (wl-draft (list (cons 'To "")
                    (cons 'Subject
                          (concat wl-forward-subject-prefix original-subject))
@@ -305,15 +308,19 @@ e.g.
   (mail-position-on-field "To"))
 
 (defun wl-draft-strip-subject-re (subject)
-  "Remove \"Re:\" from subject lines. Shamelessly copied from Gnus."
+  "Remove \"Re:\" from SUBJECT string. Shamelessly copied from Gnus."
   (if (string-match wl-subject-prefix-regexp subject)
       (substring subject (match-end 0))
     subject))
 
+(defun wl-draft-self-reply-p ()
+  "Return t when From address in the current message is user's self one or not."
+  (wl-address-user-mail-address-p (or (elmo-field-body "From") "")))
+
 (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 (wl-draft-self-reply-p)
       (if with-arg
          'wl-draft-reply-myself-with-argument-list
        'wl-draft-reply-myself-without-argument-list)
@@ -328,9 +335,10 @@ Reply to author if WITH-ARG is non-nil."
   (let (r-list
        to mail-followup-to cc subject in-reply-to references newsgroups
        to-alist cc-alist decoder parent-folder)
-    (set-buffer summary-buf)
-    (setq parent-folder (wl-summary-buffer-folder-name))
-    (set-buffer buf)
+    (when (buffer-live-p summary-buf)
+      (with-current-buffer summary-buf
+       (setq parent-folder (wl-summary-buffer-folder-name))))
+    (set-buffer (or buf mime-mother-buffer))
     (setq r-list (symbol-value (wl-draft-reply-list-symbol with-arg)))
     (catch 'done
       (while r-list
@@ -340,8 +348,15 @@ Reply to author if WITH-ARG is non-nil."
                      ((listp condition)
                       (catch 'done
                         (while condition
-                          (if (not (std11-field-body (car condition)))
-                              (throw 'done nil))
+                          (cond
+                           ((stringp (car condition))
+                            (or (std11-field-body (car condition))
+                                (throw 'done nil)))
+                           ((symbolp (car condition))
+                            (or (funcall (car condition))
+                                (throw 'done nil)))
+                           (t
+                            (debug)))
                           (setq condition (cdr condition)))
                         t))
                      ((symbolp condition)
@@ -361,7 +376,7 @@ Reply to author if WITH-ARG is non-nil."
                                              r-to-list))
                                       ",")))
            (if (and r-cc-list (symbolp r-cc-list))
-               (setq cc (wl-concat-list (funcall r-to-list) ","))
+               (setq cc (wl-concat-list (funcall r-cc-list) ","))
              (setq cc (wl-concat-list (cons cc
                                             (elmo-multiple-fields-body-list
                                              r-cc-list))
@@ -460,6 +475,9 @@ Reply to author if WITH-ARG is non-nil."
          references (wl-delete-duplicates references)
          references (if references
                         (mapconcat 'identity references "\n\t")))
+    (and wl-draft-use-frame
+        (get-buffer-window summary-buf)
+        (select-window (get-buffer-window summary-buf)))
     (wl-draft (list (cons 'To to)
                    (cons 'Cc cc)
                    (cons 'Newsgroups newsgroups)
@@ -693,7 +711,7 @@ Reply to author if WITH-ARG is non-nil."
         (insert cite-title "\n"))
     (mail-indent-citation)))
 
-(defvar wl-draft-buffer nil "Draft buffer to yank content")
+(defvar wl-draft-buffer nil "Draft buffer to yank content.")
 (defun wl-draft-yank-to-draft-buffer (buffer)
   "Yank BUFFER content to `wl-draft-buffer'."
   (set-buffer wl-draft-buffer)
@@ -745,7 +763,7 @@ Reply to author if WITH-ARG is non-nil."
                (switch-to-buffer sum-buf))))))))
 
 (defun wl-draft-delete (editing-buffer)
-  "kill the editing draft buffer and delete the file corresponds to it."
+  "Kill the editing draft buffer and delete the file corresponds to it."
   (save-excursion
     (when editing-buffer
       (set-buffer editing-buffer)
@@ -1077,12 +1095,16 @@ non-nil."
                     (wl-draft-write-sendlog 'failed 'smtp smtp-server
                                             recipients id)
                     (if (and (eq (car err) 'smtp-response-error)
-                             (/= (nth 1 err) 334))
+                             (= (nth 1 err) 535))
                         (elmo-remove-passwd
                          (wl-smtp-password-key
                           smtp-sasl-user-name
                           (car smtp-sasl-mechanisms)
                           smtp-server)))
+                    (signal (car err) (cdr err)))
+                   (quit
+                    (wl-draft-write-sendlog 'uncertain 'smtp smtp-server
+                                            recipients id)
                     (signal (car err) (cdr err)))))
                 (wl-draft-set-sent-message 'mail 'sent)
                 (wl-draft-write-sendlog
@@ -1139,15 +1161,24 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
 (defun wl-draft-normal-send-func (editing-buffer kill-when-done)
   "Send the message in the current buffer."
   (save-restriction
-    (std11-narrow-to-header mail-header-separator)
+    (narrow-to-region (goto-char (point-min))
+                     (if (re-search-forward
+                          (concat
+                           "^" (regexp-quote mail-header-separator) "$")
+                          nil t)
+                         (match-beginning 0)
+                       (point-max)))
     (wl-draft-insert-required-fields)
-    ;; Delete null fields.
-    (goto-char (point-min))
-    (while (re-search-forward "^[^ \t\n:]+:[ \t]*\n" nil t)
-      (replace-match ""))
     ;; ignore any blank lines in the header
-    (while (re-search-forward "\n\n\n*" nil t)
-      (replace-match "\n")))
+    (while (progn (goto-char (point-min))
+                 (re-search-forward "\n[ \t]*\n\n*" nil t))
+      (replace-match "\n"))
+    (goto-char (point-min))
+    (while (re-search-forward 
+           "^[^ \t\n:]+:[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n"
+           nil t)
+      (when (string= "" (match-string 1))
+       (replace-match ""))))
 ;;;  (run-hooks 'wl-mail-send-pre-hook) ;; X-PGP-Sig, Cancel-Lock
   (wl-draft-dispatch-message)
   (when kill-when-done
@@ -1160,7 +1191,7 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
   "Send the message in the current buffer.  Not modified the header fields."
   (let (delimline mime-bcc)
     (if (and wl-draft-verbose-send mes-string)
-       (message mes-string))
+       (message "%s" mes-string))
     ;; get fcc folders.
     (setq delimline (wl-draft-get-header-delimiter t))
     (unless wl-draft-fcc-list
@@ -1218,10 +1249,11 @@ If FORCE-MSGID, insert message-id regardless of `wl-insert-message-id'."
                (setq wl-draft-verbose-msg
                      (format "Sending%s and Queuing%s..."
                              sent-via unplugged-via))
-               (message (concat wl-draft-verbose-msg "done")))
+               (message "%sdone" wl-draft-verbose-msg))
            (if mes-string
-               (message (concat mes-string
-                                (if sent-via "done" "failed")))))))))
+               (message "%s%s"
+                        mes-string
+                        (if sent-via "done" "failed"))))))))
   (not wl-sent-message-modified)) ;; return value
 
 (defun wl-draft-raw-send (&optional kill-when-done force-pre-hook mes-string)
@@ -1267,22 +1299,23 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
          (wl-draft-verbose-msg nil)
          err)
       (unwind-protect
-         (save-excursion (set-buffer sending-buffer)
+         (save-excursion
+           (set-buffer sending-buffer)
            (if (and (not (wl-message-mail-p))
                     (not (wl-message-news-p)))
                (error "No recipient is specified"))
-           (expand-abbrev) ; for mail-abbrevs
+           (expand-abbrev)             ; for mail-abbrevs
            (let ((mime-header-encode-method-alist
                   (append
                    '((wl-draft-eword-encode-address-list
-                      .  (To Cc Bcc Resent-To Resent-Cc Bcc Resent-Bcc)))
+                      .  (To Cc Bcc Resent-To Resent-Cc Resent-Bcc From)))
                    (if (boundp 'mime-header-encode-method-alist)
                        (symbol-value 'mime-header-encode-method-alist)))))
              (run-hooks 'mail-send-hook) ; translate buffer
              )
            ;;
            (if wl-draft-verbose-send
-               (message (or mes-string "Sending...")))
+               (message "%s" (or mes-string "Sending...")))
            (funcall wl-draft-send-function editing-buffer kill-when-done)
            ;; Now perform actions on successful sending.
            (while mail-send-actions
@@ -1292,15 +1325,16 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                (error))
              (setq mail-send-actions (cdr mail-send-actions)))
            (if wl-draft-verbose-send
-               (message (concat (or wl-draft-verbose-msg
-                                    mes-string "Sending...")
-                                "done"))))
+               (message "%sdone"
+                        (or wl-draft-verbose-msg
+                            mes-string
+                            "Sending..."))))
        ;; kill sending buffer, anyway.
        (and (buffer-live-p sending-buffer)
             (kill-buffer sending-buffer))))))
 
 (defun wl-draft-mime-bcc-field ()
-  "Return the MIME-Bcc field body. The field is deleted."
+  "Return the MIME-Bcc field body.  The field is deleted."
   (prog1 (std11-field-body wl-draft-mime-bcc-field-name)
     (wl-draft-delete-field wl-draft-mime-bcc-field-name)))
 
@@ -1645,10 +1679,9 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                        ;;  insert symbol-value: string
   (symbol . nil)       ;;  do nothing
   nil                  ;;  do nothing
-  )
-"
+  )"
   (unless (eq major-mode 'wl-draft-mode)
-    (error "wl-draft-create-header must be use in wl-draft-mode."))
+    (error "`wl-draft-create-header' must be use in wl-draft-mode"))
   (let ((halist header-alist)
        field value)
     (while halist
@@ -1683,7 +1716,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
 
 (defun wl-draft-prepare-edit ()
   (unless (eq major-mode 'wl-draft-mode)
-    (error "wl-draft-create-header must be use in wl-draft-mode."))
+    (error "`wl-draft-create-header' must be use in wl-draft-mode"))
   (let (change-major-mode-hook)
     (wl-draft-editor-mode)
     (add-hook 'local-write-file-hooks 'wl-draft-save)
@@ -1811,7 +1844,7 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
                 (cdar condition))
            (setq condition (cdr condition)))))
     (unless elmo-nntp-default-function
-      (error "wl-draft-nntp-send: posting-function is nil."))
+      (error "wl-draft-nntp-send: posting-function is nil"))
     (if (not (elmo-plugged-p elmo-nntp-default-server elmo-nntp-default-port))
        (wl-draft-set-sent-message 'news 'unplugged
                                   (cons elmo-nntp-default-server
@@ -1863,9 +1896,23 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
        (switch-to-buffer buffer))
       (set-buffer buffer)
       (insert-file-contents-as-binary file-name)
+      (elmo-delete-cr-buffer)
       (let((mime-edit-again-ignored-field-regexp
            "^\\(Content-.*\\|Mime-Version\\):"))
-       (wl-draft-decode-message-in-buffer))
+;      (wl-draft-decode-message-in-buffer))
+       ;;;; From gnus-article-mime-edit-article-setup in T-gnus
+       ;;;; XXX: it is semi issue, perhaps [wl:10790]
+       (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+         (fset 'mime-edit-decode-single-part-in-buffer
+               (lambda (&rest args)
+                 (unless (let ((content-type (car args)))
+                           (eq 'text (mime-content-type-primary-type
+                                      content-type)))
+                   (setcar (cdr args) 'not-decode-text))
+                 (apply ofn args)))
+         (unwind-protect
+             (wl-draft-decode-message-in-buffer)
+           (fset 'mime-edit-decode-single-part-in-buffer ofn))))
       (wl-draft-insert-mail-header-separator)
       (if (not (string-match (regexp-quote wl-draft-folder)
                             (buffer-name)))
@@ -2298,11 +2345,17 @@ Automatically applied in draft sending time."
 
 (defun wl-draft-highlight-and-recenter (&optional n)
   (interactive "P")
-  (if wl-highlight-body-too
-      (let ((beg (point-min))
-           (end (point-max)))
-       (put-text-property beg end 'face nil)
-       (wl-highlight-message beg end t)))
+  (when wl-highlight-body-too
+    (let ((modified (buffer-modified-p)))
+      (unwind-protect
+         (progn
+           (put-text-property (point-min) (point-max) 'face nil)
+           (wl-highlight-message (point-min) (point-max) t))
+       (set-buffer-modified-p modified))))
+  (static-when (featurep 'xemacs)
+    ;; Cope with one of many XEmacs bugs that `recenter' takes
+    ;; a long time if there are a lot of invisible text lines.
+    (redraw-frame))
   (recenter n))
 
 ;;;; user-agent support by Sen Nagata