* wl-e21.el (wl-draft-insert-signature): Fix comment style.
[elisp/wanderlust.git] / wl / wl.el
index 26d3f7d..300e144 100644 (file)
--- a/wl/wl.el
+++ b/wl/wl.el
@@ -41,7 +41,7 @@
   (defmacro defgroup (&rest args))
   (defmacro defcustom (symbol value &optional doc &rest args)
     (let ((doc (concat "*" (or doc ""))))
-      (` (defvar (, symbol) (, value) (, doc))))))
+      `(defvar ,symbol ,value ,doc))))
 
 (require 'wl-vars)
 (require 'wl-util)
@@ -73,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))
-;;     (when (and (eq major-mode 'wl-summary-mode)
-;;                (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
-;;       (let* ((msgdb-dir (elmo-folder-msgdb-path
-;;                          wl-summary-buffer-elmo-folder))
-;;              (seen-list (elmo-msgdb-seen-load msgdb-dir)))
-;;      (setq seen-list
-;;               (wl-summary-flush-pending-append-operations seen-list))
-;;         (elmo-msgdb-seen-save msgdb-dir seen-list)))
+;;;    (when (and (eq major-mode 'wl-summary-mode)
+;;;               (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
+;;;      (let* ((msgdb-dir (elmo-folder-msgdb-path
+;;;                         wl-summary-buffer-elmo-folder))
+;;;             (seen-list (elmo-msgdb-seen-load msgdb-dir)))
+;;;        (setq seen-list
+;;;              (wl-summary-flush-pending-append-operations seen-list))
+;;;        (elmo-msgdb-seen-save msgdb-dir seen-list)))
        (run-hooks 'wl-plugged-hook))
     (wl-biff-stop)
     (run-hooks 'wl-unplugged-hook))
 (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
@@ -210,12 +215,15 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
   (setq buffer-read-only t)
   (run-hooks 'wl-plugged-mode-hook))
 
-(defmacro wl-plugged-string (plugged &optional time)
-  (` (if (, time) wl-plugged-auto-off
-       (if (, plugged) wl-plugged-plug-on wl-plugged-plug-off))))
+(defun wl-plugged-string (plugged &optional time)
+  (if time
+      wl-plugged-auto-off
+    (if plugged
+       wl-plugged-plug-on
+      wl-plugged-plug-off)))
 
-(defmacro wl-plugged-server-indent ()
-  (` (make-string wl-plugged-server-indent ? )))
+(defun wl-plugged-server-indent ()
+  (make-string wl-plugged-server-indent (string-to-char " ")))
 
 (defun wl-plugged-set-variables ()
   (setq wl-plugged-sending-queue-alist
@@ -224,8 +232,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
        (wl-plugged-dop-queue-info))
   (setq wl-plugged-alist
        (sort (copy-sequence elmo-plugged-alist)
-             '(lambda (a b)
-                (string< (caar a) (caar b))))))
+             (lambda (a b)
+               (string< (caar a) (caar b))))))
 
 (defun wl-plugged-sending-queue-info ()
   ;; sending queue status
@@ -257,7 +265,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
            (if (> len 1)
                (format ": %d msgs (" len)
              (format ": %d msg (" len))
-           (mapconcat (function int-to-string) (cdr qinfo) ",")
+           (mapconcat (function number-to-string) (cdr qinfo) ",")
            ")")))
 
 (defun wl-plugged-dop-queue-info ()
@@ -266,11 +274,11 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
         (elmo-dop-queue (copy-sequence elmo-dop-queue))
         dop-queue last alist server-info
         ope operation)
-    ;(elmo-dop-queue-load)
+;;;    (elmo-dop-queue-load)
     (elmo-dop-queue-merge)
-    (setq dop-queue (sort elmo-dop-queue '(lambda (a b)
-                                           (string< (elmo-dop-queue-fname a)
-                                                    (elmo-dop-queue-fname b)))))
+    (setq dop-queue (sort elmo-dop-queue (lambda (a b)
+                                          (string< (elmo-dop-queue-fname a)
+                                                   (elmo-dop-queue-fname b)))))
     (wl-append dop-queue (list nil)) ;; terminate(dummy)
     (when (car dop-queue)
       (setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first
@@ -286,7 +294,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
       (if (and (car dop-queue)
               (string= last (elmo-dop-queue-fname (car dop-queue))))
          (wl-append operation (list ope))
-       ;;(setq count (1+ count))
+;;;    (setq count (1+ count))
        (when (and last (setq server-info (elmo-net-port-info
                                           (wl-folder-get-elmo-folder last))))
          (setq alist
@@ -305,29 +313,29 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
   (let ((operations (cdr qinfo))
        (column (or column wl-plugged-queue-status-column)))
     (mapconcat
-     '(lambda (folder-ope)
-       (concat (wl-plugged-set-folder-icon
-                (car folder-ope)
-                (wl-folder-get-petname (car folder-ope)))
-               "("
-               (let ((opes (cdr folder-ope))
-                     pair shrinked)
-                 (while opes
-                   (if (setq pair (assoc (car (car opes)) shrinked))
-                       (setcdr pair (+ (cdr pair)
-                                       (max (cdr (car opes)) 1)))
-                     (setq shrinked (cons
-                                     (cons (car (car opes))
-                                           (max (cdr (car opes)) 1))
-                                     shrinked)))
-                   (setq opes (cdr opes)))
-                 (mapconcat
-                  '(lambda (ope)
-                     (if (> (cdr ope) 0)
-                         (format "%s:%d" (car ope) (cdr ope))
-                       (format "%s" (car ope))))
-                  (nreverse shrinked) ","))
-               ")"))
+     (lambda (folder-ope)
+       (concat (wl-plugged-set-folder-icon
+               (car folder-ope)
+               (wl-folder-get-petname (car folder-ope)))
+              "("
+              (let ((opes (cdr folder-ope))
+                    pair shrinked)
+                (while opes
+                  (if (setq pair (assoc (car (car opes)) shrinked))
+                      (setcdr pair (+ (cdr pair)
+                                      (max (cdr (car opes)) 1)))
+                    (setq shrinked (cons
+                                    (cons (car (car opes))
+                                          (max (cdr (car opes)) 1))
+                                    shrinked)))
+                  (setq opes (cdr opes)))
+                (mapconcat
+                 (lambda (ope)
+                   (if (> (cdr ope) 0)
+                       (format "%s:%d" (car ope) (cdr ope))
+                     (format "%s" (car ope))))
+                 (nreverse shrinked) ","))
+              ")"))
      operations
      (concat "\n" (wl-set-string-width column "")))))
 
@@ -372,7 +380,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
       ;; port plug
       (setq line
            (format "%s[%s]%s"
-                   (make-string wl-plugged-port-indent ? )
+                   (make-string wl-plugged-port-indent (string-to-char " "))
                    (wl-plugged-string plugged time)
                    (cond
                     ((stringp port)
@@ -412,7 +420,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 (defun wl-plugged-redrawing-switch (indent switch &optional time)
   (beginning-of-line)
   (when (re-search-forward
-        (format "^%s\\[\\([^]]+\\)\\]" (make-string indent ? )))
+        (format "^%s\\[\\([^]]+\\)\\]"
+                (make-string indent (string-to-char " "))))
     (goto-char (match-beginning 1))
     (delete-region (match-beginning 1) (match-end 1))
     (insert (wl-plugged-string switch time))
@@ -453,8 +462,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
                          (/ (frame-height) 2)
                        (window-height)))
           window-lines lines)
-      (save-excursion
-       (set-buffer (get-buffer-create wl-plugged-buf-name))
+      (with-current-buffer (get-buffer-create wl-plugged-buf-name)
        (wl-plugged-mode)
        (buffer-disable-undo (current-buffer))
        (delete-windows-on (current-buffer))
@@ -498,7 +506,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
        (let (variable switch name)
          (goto-char cur-point)
          (when (and (not (bobp))
-                    (not (eq (char-before) ? )))
+                    (not (eq (char-before) (string-to-char " "))))
            (if (re-search-backward " [^ ]+" nil t)
                (forward-char 1)
              (re-search-backward "^[^ ]+" nil t)))
@@ -524,7 +532,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
           ((eq indent wl-plugged-port-indent)  ;; toggle port plug
            (cond
             ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
-             (setq port (string-to-int (elmo-match-string 2 name)))
+             (setq port (string-to-number (elmo-match-string 2 name)))
              (if (string-match "!" (setq name-1 (elmo-match-string 1 name)))
                  (setq stream-type
                        (intern (substring name-1 (match-end 0))))))
@@ -565,8 +573,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 
 (defun wl-plugged-exit ()
   (interactive)
-  (setq ;;elmo-plugged-alist wl-plugged-alist
-       wl-plugged wl-plugged-switch
+  (setq wl-plugged wl-plugged-switch
+;;;    elmo-plugged-alist wl-plugged-alist
        wl-plugged-alist nil
        wl-plugged-sending-queue-alist nil
        wl-plugged-dop-queue-alist nil)
@@ -631,23 +639,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"))
 
@@ -658,6 +676,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)
@@ -670,11 +689,12 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
                        "\\|")))
     (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))
+;;;    (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.
   )
@@ -696,9 +716,30 @@ 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
@@ -793,7 +834,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
@@ -812,17 +852,19 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
                (wl-check-variables-2)
                (message "Checking type of variables...done")))
          (let ((inhibit-quit t))
-           (wl-plugged-init (wl-folder arg)))
+           (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))
        (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))
@@ -864,23 +906,21 @@ If ARG (prefix argument) is specified, folder checkings are skipped."
 
 ;; Define some autoload functions WL might use.
 (eval-and-compile
-  ;; This little mapcar goes through the list below and marks the
+  ;; This little mapc goes through the list below and marks the
   ;; symbols in question as autoloaded functions.
-  (mapcar
-   (function
-    (lambda (package)
-      (let ((interactive (nth 1 (memq ':interactive package))))
-       (mapcar
-        (function
-         (lambda (function)
-           (let (keymap)
-             (when (consp function)
-               (setq keymap (car (memq 'keymap function)))
-               (setq function (car function)))
-             (autoload function (car package) nil interactive keymap))))
-        (if (eq (nth 1 package) ':interactive)
-            (cdddr package)
-          (cdr package))))))
+  (mapc
+   (lambda (package)
+     (let ((interactive (nth 1 (memq ':interactive package))))
+       (mapc
+       (lambda (function)
+         (let (keymap)
+           (when (consp function)
+             (setq keymap (car (memq 'keymap function)))
+             (setq function (car function)))
+           (autoload function (car package) nil interactive keymap)))
+       (if (eq (nth 1 package) ':interactive)
+           (cdddr package)
+         (cdr package)))))
    '(("wl-fldmgr" :interactive t
       wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
       wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
@@ -907,7 +947,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)