(wl-score-ov-entity-get): Call 'elmo-message-entity-field' with TYPE artgument.
[elisp/wanderlust.git] / wl / wl.el
index cb0315e..aae6edb 100644 (file)
--- a/wl/wl.el
+++ b/wl/wl.el
 (provide 'wl)                          ; circular dependency
 (require 'wl-folder)
 (require 'wl-summary)
+(require 'wl-action)
 (require 'wl-thread)
 (require 'wl-address)
+(require 'wl-news)
 
 (wl-draft-mode-setup)
 (require 'wl-draft)
@@ -71,7 +73,8 @@
   (require 'smtp)
   (require 'wl-score)
   (require 'wl-fldmgr)
-  (require 'wl-mime))
+  (require 'wl-mime)
+  (require 'wl-spam))
 
 (defun wl-plugged-init (&optional make-alist)
   (setq elmo-plugged wl-plugged)
       (progn
        ;; flush queue!!
        (elmo-dop-queue-flush)
-       (unless queue-flush-only (wl-biff-start))
+       (unless queue-flush-only
+         (when wl-biff-check-folder-list
+           (wl-biff-check-folders)
+           (wl-biff-start)))
        (if (and wl-draft-enable-queuing
                 wl-auto-flush-queue)
            (wl-draft-queue-flush))
 (defvar wl-plugged-port-label-alist
   (list (cons 119 "nntp")
        (cons 143 "imap4")
-       (cons 110 "pop3")))
+       (cons 110 "pop3")
+       (cons 25 "smtp")))
        ;;(cons elmo-pop-before-smtp-port "pop3")
 
 (defconst wl-plugged-switch-variables
@@ -629,23 +636,33 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
   (wl-save-status 'keep-summary)
   (run-hooks 'wl-save-hook))
 
+(defun wl-execute-temp-marks ()
+  "Execute temporary marks in summary buffers."
+  (interactive)
+  (let ((summaries (wl-collect-summary)))
+    (while summaries
+      (with-current-buffer (car summaries)
+       (wl-summary-exec-with-confirmation)
+       (wl-summary-save-status))
+      (setq summaries (cdr summaries)))))
+
 (defun wl-save-status (&optional keep-summary)
   (message "Saving summary and folder status...")
-  (let (summary-buf)
-    (save-excursion
-      (let ((summaries (wl-collect-summary)))
-       (while summaries
-         (with-current-buffer (car summaries)
-           (unless keep-summary
-             (wl-summary-cleanup-temp-marks))
-           (wl-summary-save-view)
-           (elmo-folder-commit wl-summary-buffer-elmo-folder)
-           (unless keep-summary
-             (kill-buffer (car summaries))))
-         (setq summaries (cdr summaries))))))
+  (save-excursion
+    (let ((summaries (wl-collect-summary)))
+      (while summaries
+       (with-current-buffer (car summaries)
+         (unless keep-summary
+           (wl-summary-cleanup-temp-marks))
+         (wl-summary-save-view)
+         (elmo-folder-commit wl-summary-buffer-elmo-folder)
+         (unless keep-summary
+           (kill-buffer (car summaries))))
+       (setq summaries (cdr summaries)))))
   (wl-refile-alist-save)
   (wl-folder-info-save)
   (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
+  (and (featurep 'wl-spam) (wl-spam-save-status))
   (elmo-crosspost-message-alist-save)
   (message "Saving summary and folder status...done"))
 
@@ -656,6 +673,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
     (elmo-quit)
     (when wl-use-acap (funcall (symbol-function 'wl-acap-exit)))
     (wl-biff-stop)
+    (elmo-clear-signal-slots)
     (run-hooks 'wl-exit-hook)
     (wl-save-status)
     (wl-folder-cleanup-variables)
@@ -666,11 +684,14 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
                        (list wl-folder-buffer-name
                              wl-plugged-buf-name)
                        "\\|")))
-    (if (and wl-folder-use-frame
-            (> (length (visible-frame-list)) 1))
-       (delete-frame))
+    (when wl-delete-startup-frame-function
+      (funcall wl-delete-startup-frame-function))
+;;    (if (and wl-folder-use-frame
+;;          (> (length (visible-frame-list)) 1))
+;;     (delete-frame))
     (setq wl-init nil)
     (remove-hook 'kill-emacs-hook 'wl-save-status)
+    (elmo-passwd-alist-clear)
     t)
   (message "") ; empty minibuffer.
   )
@@ -692,8 +713,31 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
          (symbol-value 'wl-summary-subject-function))
     (fset 'wl-summary-subject-filter-func-internal
          (symbol-value 'wl-summary-subject-filter-function))
+    (wl-summary-define-sort-command)
+    (wl-summary-define-mark-action)
+    (dolist (spec wl-summary-flag-alist)
+      (set-face-foreground
+       (make-face (intern
+                  (format "wl-highlight-summary-%s-flag-face" (car spec))))
+       (nth 1 spec)))
+    (setq elmo-get-folder-function #'wl-folder-make-elmo-folder
+         elmo-progress-callback-function #'wl-progress-callback-function)
     (setq elmo-no-from wl-summary-no-from-message)
     (setq elmo-no-subject wl-summary-no-subject-message)
+    (elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
+    (elmo-connect-signal
+     nil
+     'message-number-changed
+     'wl-draft
+     (elmo-define-signal-handler (listener folder old-number new-number)
+       (dolist (buffer (wl-collect-draft))
+        (with-current-buffer buffer
+          (wl-draft-buffer-change-number old-number new-number)))
+       (wl-draft-rename-saved-config old-number new-number))
+     (elmo-define-signal-filter (listener folder old-number new-number)
+       (and folder
+           (string= (elmo-folder-name-internal folder) wl-draft-folder))))
+    (wl-news-check)
     (setq wl-init t)
     ;; This hook may contain the functions `wl-plugged-init-icons' and
     ;; `wl-biff-init-icons' for reasons of system internal to accord
@@ -701,36 +745,29 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
     (run-hooks 'wl-init-hook)))
 
 (defun wl-check-environment (no-check-folder)
-  (unless wl-from (error "Please set `wl-from'"))
+  (unless wl-from (error "Please set `wl-from' to your mail address"))
   ;; Message-ID
-  (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'")))
+  (when wl-insert-message-id
+    (let ((message-id (funcall wl-message-id-function))
+         domain)
+      (unless (string-match "^<\\([^@]*\\)@\\([^@]*\\)>$" message-id)
+       (cond
+        ((string-match "@" wl-message-id-domain)
+         (error "Please remove `@' from `wl-message-id-domain'"))
+        (t
+         (error
+          "Check around `wl-message-id-function' to get valid Message-ID string"))))
+      (setq domain (match-string 2 message-id))
+      (if (or (not (string-match "[^.]\\.[^.]" domain))
+             (string= domain "localhost.localdomain"))
+         (elmo-warning
+          "Please set `wl-message-id-domain' to get valid Message-ID string."))))
   ;; folders
   (when (not no-check-folder)
     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
          (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
-         (trash-folder (wl-folder-get-elmo-folder wl-trash-folder))
          (lost+found-folder (wl-folder-get-elmo-folder
                              elmo-lost+found-folder)))
-      (if (not (elmo-folder-message-file-p draft-folder))
-         (error "%s is not allowed for draft folder" wl-draft-folder))
       (unless (elmo-folder-exists-p draft-folder)
        (if (y-or-n-p
             (format "Draft Folder %s does not exist, create it? "
@@ -745,12 +782,6 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
              (elmo-folder-create queue-folder)
            (error "Queue Folder is not created")))
       (when (not (eq no-check-folder 'wl-draft))
-       (unless (elmo-folder-exists-p trash-folder)
-         (if (y-or-n-p
-              (format "Trash Folder %s does not exist, create it? "
-                      wl-trash-folder))
-             (elmo-folder-create trash-folder)
-           (error "Trash Folder is not created")))
        (unless (elmo-folder-exists-p lost+found-folder)
          (elmo-folder-create lost+found-folder)))
       ;; tmp dir
@@ -785,7 +816,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 
 (defun wl-check-variables-2 ()
   (if (< wl-message-buffer-cache-size 1)
-      (error "`wl-message-buffer-cache-size' must be larger than 0."))
+      (error "`wl-message-buffer-cache-size' must be larger than 0"))
   (when wl-message-buffer-prefetch-depth
     (if (not (< wl-message-buffer-prefetch-depth
                wl-message-buffer-cache-size))
@@ -800,7 +831,6 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
   (interactive "P")
   (unless wl-init
     (wl-load-profile)
-    (wl-folder-init)
     (elmo-init))
   (let (demo-buf check)
     (unless wl-init
@@ -818,22 +848,59 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
                (wl-check-variables)
                (wl-check-variables-2)
                (message "Checking type of variables...done")))
-         (wl-plugged-init (wl-folder arg))
+         (let ((inhibit-quit t))
+           (wl-plugged-init (wl-folder)))
          (unless arg
            (run-hooks 'wl-auto-check-folder-pre-hook)
            (wl-folder-auto-check)
-           (run-hooks 'wl-auto-check-folder-hook))
-         (unless arg (wl-biff-start)))
+           (run-hooks 'wl-auto-check-folder-hook)))
       (error
        (if (buffer-live-p demo-buf)
           (kill-buffer demo-buf))
-       (setq wl-init nil)
        (signal (car obj)(cdr obj)))
       (quit))
+    (when wl-biff-check-folder-list
+      (unless arg (wl-biff-check-folders))
+      (wl-biff-start))
     (if (buffer-live-p demo-buf)
        (kill-buffer demo-buf)))
   (run-hooks 'wl-hook))
 
+(defvar wl-delete-startup-frame-function nil)
+
+;;;###autoload
+(defun wl-other-frame (&optional arg)
+  "Pop up a frame to read messages via Wanderlust."
+  (interactive)
+  (if wl-folder-use-frame
+      (wl arg)
+    (let ((focusing-functions (append '(raise-frame select-frame)
+                                     (if (fboundp 'x-focus-frame)
+                                         '(x-focus-frame)
+                                       '(focus-frame))))
+         (folder (get-buffer wl-folder-buffer-name))
+         window frame wl-folder-use-frame)
+      (if (and folder
+              (setq window (get-buffer-window folder t))
+              (window-live-p window)
+              (setq frame (window-frame window)))
+         (progn
+           (while focusing-functions
+             (funcall (car focusing-functions) frame)
+             (setq focusing-functions (cdr focusing-functions)))
+           (wl arg))
+       (setq frame (make-frame))
+       (while focusing-functions
+         (funcall (car focusing-functions) frame)
+         (setq focusing-functions (cdr focusing-functions)))
+       (setq wl-delete-startup-frame-function
+             `(lambda ()
+                (setq wl-delete-startup-frame-function nil)
+                (let ((frame ,frame))
+                  (if (eq (selected-frame) frame)
+                      (delete-frame frame)))))
+       (wl arg)))))
+
 ;; Define some autoload functions WL might use.
 (eval-and-compile
   ;; This little mapcar goes through the list below and marks the
@@ -879,7 +946,8 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
       wl-score-change-score-file wl-score-edit-current-scores
       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
       wl-score-set-mark-below wl-score-set-expunge-below
-      wl-summary-increase-score wl-summary-lower-score ))))
+      wl-summary-increase-score wl-summary-lower-score )
+     ("wl-draft" wl-draft-rename-saved-config))))
 
 ;; for backward compatibility
 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)