* wl.el (wl-check-environment): Undo last change.
[elisp/wanderlust.git] / wl / wl-draft.el
index 7c85068..3a6b4a9 100644 (file)
                             wl-smtp-authenticate-type
                           (list wl-smtp-authenticate-type)))))
            (smtp-use-sasl (and smtp-sasl-mechanisms t))
-           (smtp-use-starttls wl-smtp-connection-type)
+           (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?
 (defun wl-draft-insert-x-face-field ()
   "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."
@@ -453,15 +453,11 @@ Reply to author if WITH-ARG is non-nil."
 (defun wl-draft-confirm ()
   "Confirm send message."
   (interactive)
-  (y-or-n-p (format "Send current draft as %s? "
-                   (cond ((and (wl-message-mail-p) (wl-message-news-p))
-                          "Mail and News")
-                         ((wl-message-mail-p) "Mail")
-                         ((wl-message-news-p) "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."
@@ -469,9 +465,14 @@ Reply to author if WITH-ARG is non-nil."
     (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..
@@ -491,9 +492,8 @@ Reply to author if WITH-ARG is non-nil."
   (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)
@@ -509,6 +509,12 @@ Reply to author if WITH-ARG is non-nil."
                        (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
@@ -530,8 +536,10 @@ Reply to author if WITH-ARG is non-nil."
                   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)))
@@ -540,20 +548,15 @@ Reply to author if WITH-ARG is non-nil."
 
 (defun wl-draft-insert-current-message (dummy)
   (interactive)
-  (let (mail-reply-buffer
+  (let ((mail-reply-buffer (wl-message-get-original-buffer))
        mail-citation-hook mail-yank-hooks
        wl-draft-add-references wl-draft-cite-func)
-    (with-current-buffer wl-draft-buffer-cur-summary-buffer
-      (with-current-buffer wl-message-buffer
-       (setq mail-reply-buffer (wl-message-get-original-buffer))))
-    (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))))
+      (wl-draft-yank-from-mail-reply-buffer nil
+                                           wl-ignored-forwarded-headers))))
 
 (defun wl-draft-insert-get-message (dummy)
   (let ((fld (completing-read
@@ -572,11 +575,8 @@ Reply to author if WITH-ARG is non-nil."
        wl-draft-cite-func)
     (unwind-protect
        (progn
-         (elmo-message-fetch (wl-folder-get-elmo-folder fld)
-                             number
-                             ;; No cache.
-                             (elmo-make-fetch-strategy 'entire)
-                             nil mail-reply-buffer)
+         (save-excursion
+           (elmo-read-msg-with-cache fld number mail-reply-buffer nil))
          (wl-draft-yank-from-mail-reply-buffer nil))
       (kill-buffer mail-reply-buffer))))
 
@@ -600,8 +600,11 @@ Reply to author if WITH-ARG is non-nil."
                  (save-excursion
                    (set-buffer message-buf)
                    wl-message-buffer-cur-number))
-           (setq entity (elmo-msgdb-overview-get-entity
-                         num (wl-summary-buffer-msgdb)))
+           (setq entity (assoc (cdr (assq num
+                                          (elmo-msgdb-get-number-alist
+                                           wl-summary-buffer-msgdb)))
+                               (elmo-msgdb-get-overview
+                                wl-summary-buffer-msgdb)))
            (setq from (elmo-msgdb-overview-entity-get-from entity))
            (setq date (elmo-msgdb-overview-entity-get-date entity)))
          (setq cite-title (format "At %s,\n%s wrote:"
@@ -676,7 +679,7 @@ Reply to author if WITH-ARG is non-nil."
            (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))))
@@ -695,11 +698,11 @@ Reply to author if WITH-ARG is non-nil."
     (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
 
@@ -1037,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-file-cache-save id 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)
@@ -1137,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 ()
@@ -1205,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)
@@ -1215,8 +1218,7 @@ If optional argument is non-nil, current draft buffer is killed"
                       (point)))
                    fcc-list))
        (save-match-data
-         (wl-folder-confirm-existence
-          (wl-folder-get-elmo-folder (eword-decode-string (car fcc-list)))))
+         (wl-folder-confirm-existence (eword-decode-string (car fcc-list))))
        (delete-region (match-beginning 0)
                       (progn (forward-line 1) (point)))))
     fcc-list))
@@ -1243,14 +1245,13 @@ If optional argument is non-nil, current draft buffer is killed"
            cache-saved)
        (while fcc-list
          (unless (or cache-saved
-                     (elmo-folder-plugged-p
-                      (wl-folder-get-elmo-folder (car fcc-list))))
-           (elmo-file-cache-save id nil) ;; for disconnected operation
+                     (elmo-folder-plugged-p (car fcc-list)))
+           (elmo-cache-save id nil nil nil) ;; for disconnected operation
            (setq cache-saved t))
-         (if (elmo-folder-append-buffer
-              (wl-folder-get-elmo-folder
-               (eword-decode-string (car fcc-list)))
-              id)
+         (if (elmo-append-msg (eword-decode-string (car fcc-list))
+                              (buffer-substring
+                               (point-min) (point-max))
+                              id)
              (wl-draft-write-sendlog 'ok 'fcc nil (car fcc-list) id)
            (wl-draft-write-sendlog 'failed 'fcc nil (car fcc-list) id))
          (setq fcc-list (cdr fcc-list)))))
@@ -1277,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)
@@ -1294,22 +1291,20 @@ If optional argument is non-nil, current draft buffer is killed"
     (wl-load-profile))
   (wl-init 'wl-draft) ;; returns immediately if already initialized.
   (if (interactive-p)
-      (setq summary-buf (wl-summary-get-buffer (wl-summary-buffer-folder-name))))
-  (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+      (setq summary-buf (wl-summary-get-buffer wl-summary-buffer-folder-name)))
+  (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder))
        buf-name file-name num wl-demo change-major-mode-hook)
-    (if (not (elmo-folder-message-file-p draft-folder))
+    (if (not (eq (car draft-folder-spec) 'localdir))
        (error "%s folder cannot be used for draft folder" wl-draft-folder))
-    (setq num (elmo-max-of-list
-              (or (elmo-folder-list-messages draft-folder) '(0))))
+    (setq num (elmo-max-of-list (or (elmo-list-folder wl-draft-folder) '(0))))
     (setq num (+ 1 num))
     ;; To get unused buffer name.
     (while (get-buffer (concat wl-draft-folder "/" (int-to-string num)))
       (setq num (+ 1 num)))
     (setq buf-name (find-file-noselect
                    (setq file-name
-                         (elmo-message-file-name
-                          (wl-folder-get-elmo-folder wl-draft-folder)
-                          num))))
+                         (elmo-get-msg-filename wl-draft-folder
+                                                num))))
     (if wl-draft-use-frame
        (switch-to-buffer-other-frame buf-name)
       (switch-to-buffer buf-name))
@@ -1320,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)
@@ -1346,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
@@ -1365,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))
@@ -1386,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))
@@ -1411,6 +1402,21 @@ If optional argument is non-nil, current draft buffer is killed"
                                                  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
@@ -1451,10 +1457,14 @@ If optional argument is non-nil, current draft buffer is killed"
       (current-buffer))))
 
 (defun wl-draft-reedit (number)
-  (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
+  (let ((draft-folder-spec (elmo-folder-get-spec wl-draft-folder))
        (wl-draft-reedit t)
        buf-name file-name change-major-mode-hook)
-    (setq file-name (elmo-message-file-name draft-folder number))
+    (setq file-name (expand-file-name
+                    (int-to-string number)
+                    (expand-file-name
+                     (nth 1 draft-folder-spec)
+                     elmo-localdir-folder-path)))
     (unless (file-exists-p file-name)
       (error "File %s does not exist" file-name))
     (setq buf-name (find-file-noselect file-name))
@@ -1473,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)
@@ -1687,8 +1694,7 @@ If optional argument is non-nil, current draft buffer is killed"
            (insert (concat field ": " content "\n"))))))))
 
 (defun wl-draft-config-info-operation (msg operation)
-  (let* ((msgdb-dir (elmo-folder-msgdb-path (wl-folder-get-elmo-folder
-                                            wl-draft-folder)))
+  (let* ((msgdb-dir (elmo-msgdb-expand-path wl-draft-folder))
         (filename
          (expand-file-name
           (format "%s-%d" wl-draft-config-save-filename msg)
@@ -1713,8 +1719,7 @@ If optional argument is non-nil, current draft buffer is killed"
 
 (defun wl-draft-queue-info-operation (msg operation
                                          &optional add-sent-message-via)
-  (let* ((msgdb-dir (elmo-folder-msgdb-path
-                    (wl-folder-get-elmo-folder wl-queue-folder)))
+  (let* ((msgdb-dir (elmo-msgdb-expand-path wl-queue-folder))
         (filename
          (expand-file-name
           (format "%s-%d" wl-draft-queue-save-filename msg)
@@ -1748,14 +1753,15 @@ If optional argument is non-nil, current draft buffer is killed"
   (if wl-draft-verbose-send
       (message "Queuing..."))
   (let ((send-buffer (current-buffer))
-       (folder (wl-folder-get-elmo-folder wl-queue-folder))
        (message-id (std11-field-body "Message-ID")))
-    (if (elmo-folder-append-buffer folder t)
+    (if (elmo-append-msg wl-queue-folder
+                        (buffer-substring (point-min) (point-max))
+                        message-id)
        (progn
          (if message-id
              (elmo-dop-lock-message message-id))
          (wl-draft-queue-info-operation
-          (car (elmo-folder-status folder))
+          (car (elmo-max-of-folder wl-queue-folder))
           'save wl-sent-message-via)
          (wl-draft-write-sendlog 'ok 'queue nil wl-queue-folder message-id)
          (when wl-draft-verbose-send
@@ -1767,12 +1773,11 @@ If optional argument is non-nil, current draft buffer is killed"
 (defun wl-draft-queue-flush ()
   "Flush draft queue."
   (interactive)
-  (let* ((queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
-        (msgs2 (elmo-folder-list-messages queue-folder))
-        (i 0)
-        (performed 0)
-        (wl-draft-queue-flushing t)
-        msgs failure len buffer msgid sent-via)
+  (let ((msgs2 (elmo-list-folder wl-queue-folder))
+       (i 0)
+       (performed 0)
+       (wl-draft-queue-flushing t)
+       msgs failure len buffer msgid sent-via)
     ;; get plugged send message
     (while msgs2
       (setq sent-via (wl-draft-queue-info-operation (car msgs2) 'get-sent-via))
@@ -1803,9 +1808,8 @@ If optional argument is non-nil, current draft buffer is killed"
                      failure nil)
                (setq wl-sent-message-via nil)
                (wl-draft-queue-info-operation (car msgs) 'load)
-               (elmo-message-fetch queue-folder
-                                   (car msgs)
-                                   (elmo-make-fetch-strategy 'entire))
+               (elmo-read-msg-no-cache wl-queue-folder (car msgs)
+                                       (current-buffer))
                (condition-case err
                    (setq failure (funcall
                                   wl-draft-queue-flush-send-func
@@ -1818,8 +1822,7 @@ If optional argument is non-nil, current draft buffer is killed"
                  (quit
                   (setq failure t)))
                (unless failure
-                 (elmo-folder-delete-messages
-                  queue-folder (cons (car msgs) nil))
+                 (elmo-delete-msgs wl-queue-folder (cons (car msgs) nil))
                  (wl-draft-queue-info-operation (car msgs) 'delete)
                  (elmo-dop-unlock-message (std11-field-body "Message-ID"))
                  (setq performed (+ 1 performed)))
@@ -1837,8 +1840,10 @@ If optional argument is non-nil, current draft buffer is killed"
     (let ((bufs (buffer-list))
          (draft-regexp (concat
                         "^" (regexp-quote
-                             (elmo-localdir-folder-directory-internal
-                              (wl-folder-get-elmo-folder wl-draft-folder)))))
+                             (expand-file-name
+                              (nth 1 (elmo-folder-get-spec wl-draft-folder))
+                              (expand-file-name
+                               elmo-localdir-folder-path)))))
          buf draft-bufs)
       (while bufs
        (if (and
@@ -1858,8 +1863,7 @@ If optional argument is non-nil, current draft buffer is killed"
        (switch-to-buffer buf))))))
 
 (defun wl-jump-to-draft-folder ()
-  (let ((msgs (reverse (elmo-folder-list-messages (wl-folder-get-elmo-folder
-                                                  wl-draft-folder))))
+  (let ((msgs (reverse (elmo-list-folder wl-draft-folder)))
        (mybuf (buffer-name))
        msg buf)
     (if (not msgs)