* wl-folder.el (wl-folder-init-hook): New hook.
[elisp/wanderlust.git] / wl / wl-folder.el
index 5a47007..c2e374c 100644 (file)
@@ -1,4 +1,4 @@
-;;; wl-folder.el -- Folder mode for Wanderlust.
+;;; wl-folder.el --- Folder mode for Wanderlust.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
   (require 'wl)
   (require 'elmo-nntp))
 
+(defcustom wl-folder-init-hook nil
+  "A hook called after folder initialization is finished."
+  :type 'hook
+  :group 'wl)
+
 (defvar wl-folder-buffer-name "Folder")
 (defvar wl-folder-entity nil)          ; desktop entity.
 (defvar wl-folder-group-alist nil)     ; opened or closed
                          entity (or hashtb wl-folder-entity-id-name-hashtb))))
 
 (defmacro wl-folder-get-entity-id (entity)
-  (` (or (get-text-property 0
-                           'wl-folder-entity-id
-                           (, entity))
-        (, entity)))) ;; for nemacs
+  `(get-text-property 0 'wl-folder-entity-id ,entity))
 
 (defmacro wl-folder-get-entity-from-buffer (&optional getid)
-  (` (let ((id (get-text-property (point)
-                                 'wl-folder-entity-id)))
-       (if (not id) ;; for nemacs
-          (wl-folder-get-realname (wl-folder-folder-name))
-        (if (, getid)
-            id
-          (wl-folder-get-folder-name-by-id id))))))
+  `(let ((id (get-text-property (point)
+                               'wl-folder-entity-id)))
+     (if ,getid
+        id
+       (wl-folder-get-folder-name-by-id id))))
 
 (defmacro wl-folder-entity-exists-p (entity &optional hashtb)
   (` (let ((sym (intern-soft (, entity)
 (defun wl-folder-persistent-p (folder)
   (or (and (wl-folder-search-entity-by-name folder wl-folder-entity
                                            'folder)
-          t)   ; on Folder mode.
+          t) ; on Folder mode.
       (catch 'found
        (let ((li wl-save-folder-list))
          (while li
@@ -821,8 +821,12 @@ Optional argument ARG is repeart count."
          (wl-folder-sync-entity entity)
          (setq nums (elmo-folder-diff folder)))
       (unless wl-folder-notify-deleted
-       (setq unsync (if (and (car nums) (> 0 (car nums))) 0 (car nums)))
-       (setq nomif (if (and (car nums) (> 0 (cdr nums))) 0 (cdr nums)))
+       (setq unsync (if (car nums)
+                        (max 0 (car nums))
+                      nil))
+       (setq nomif (if (cdr nums)
+                       (max 0 (cdr nums))
+                     nil))
        (setq nums (cons unsync nomif)))
       (setq unread (or ;; If server diff, All unreads are
                        ; treated as unsync.
@@ -832,7 +836,6 @@ Optional argument ARG is repeart count."
                    (wl-summary-count-unread (elmo-msgdb-mark-load
                                              (elmo-folder-msgdb-path
                                               folder)))))
-      (setq unread (min unread (- (or (cdr nums) 0) (or (car nums) 0))))
       (when new (setq unread (- unread new)))
       (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
                                   (list (or new (car nums))
@@ -842,8 +845,10 @@ Optional argument ARG is repeart count."
     (setq wl-folder-info-alist-modified t)
     (sit-for 0)
     (list (if wl-folder-notify-deleted
-             (car nums)
-           (or new (max (or (car nums) 0)))) unread (cdr nums))))
+             (or new (car nums) 0)
+           (max 0 (or new (car nums) 0)))
+         unread
+         (cdr nums))))
 
 (defun wl-folder-check-entity-async (entity &optional auto)
   (let ((elmo-nntp-groups-async t)
@@ -892,7 +897,7 @@ Optional argument ARG is repeart count."
        (setq ret-val
              (wl-folder-add-folder-info
               ret-val
-              (wl-folder-check-one-entity (elmo-folder-name-internal 
+              (wl-folder-check-one-entity (elmo-folder-name-internal
                                            folder))))
        ;;(sit-for 0)
        ))
@@ -1770,7 +1775,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
            (goto-char (point-min))
            (while (wl-folder-buffer-search-entity name)
              (wl-folder-update-line value))))))))
-  
+
 (defun wl-folder-update-unread (folder unread)
 ;  (save-window-excursion
     (let ((buf (get-buffer wl-folder-buffer-name))
@@ -1996,7 +2001,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
   (interactive)
   (if wl-use-acap
       (wl-acap-init)
-    (funcall wl-folder-init-function)))
+    (funcall wl-folder-init-function))
+  (run-hooks 'wl-folder-init-hook))
 
 (defun wl-local-folder-init ()
   "Initialize local folder."
@@ -2029,9 +2035,11 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 (defun wl-folder-get-newsgroups (folder)
   "Return Newsgroups field value string for FOLDER newsgroup.
 If FOLDER is multi, return comma separated string (cross post)."
-  (list nil nil (mapconcat 'identity
-                          (elmo-folder-newsgroups folder)
-                          ",")))
+  (let ((nlist (elmo-folder-newsgroups
+                       (wl-folder-get-elmo-folder folder))))
+    (if nlist
+       (list nil nil (mapconcat 'identity nlist ","))
+      nil)))
 
 (defun wl-folder-guess-mailing-list-by-refile-rule (entity)
   "Return ML address guess by FOLDER.
@@ -2039,17 +2047,18 @@ Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'."
   (let ((flist
         (elmo-folder-get-primitive-list
          (wl-folder-get-elmo-folder entity)))
-       fld ret mlist)
+       fld mladdr to)
     (while (setq fld (car flist))
-      (if (setq ret
-               (wl-folder-guess-mailing-list-by-refile-rule-subr
-                (elmo-folder-name-internal fld)))
-         (setq mlist (if (stringp mlist)
-                         (concat mlist ", " ret)
-                       ret)))
+      (setq mladdr (wl-folder-guess-mailing-list-by-refile-rule-subr
+                   (elmo-folder-name-internal fld)))
+      (when mladdr
+       (setq to (if (stringp to)
+                    (concat to ", " mladdr)
+                  mladdr)))
       (setq flist (cdr flist)))
-    (if mlist
-       (list mlist nil nil))))
+    (if (stringp to)
+       (list to nil nil)
+      nil)))
 
 (defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity)
   (unless (memq (elmo-folder-type entity)
@@ -2076,17 +2085,18 @@ Use `wl-subscribed-mailing-list'."
   (let ((flist
         (elmo-folder-get-primitive-list
          (wl-folder-get-elmo-folder entity)))
-       fld ret mlist)
+       fld mladdr to)
     (while (setq fld (car flist))
-      (if (setq ret
-               (wl-folder-guess-mailing-list-by-folder-name-subr
-                (elmo-folder-name-internal fld)))
-         (setq mlist (if (stringp mlist)
-                         (concat mlist ", " ret)
-                       ret)))
+      (setq mladdr (wl-folder-guess-mailing-list-by-folder-name-subr
+                   (elmo-folder-name-internal fld)))
+      (when mladdr
+       (setq to (if (stringp to)
+                    (concat to ", " mladdr)
+                  mladdr)))
       (setq flist (cdr flist)))
-    (if mlist
-       (list mlist nil nil))))
+    (if (stringp to)
+       (list to nil nil)
+      nil)))
 
 (defun wl-folder-guess-mailing-list-by-folder-name-subr (entity)
   (when (memq (elmo-folder-type entity)
@@ -2193,7 +2203,7 @@ Use `wl-subscribed-mailing-list'."
                                 (wl-summary-get-sync-range
                                  (wl-folder-get-elmo-folder fld-name))
                                 nil sticky t)))
-  
+
 (defun wl-folder-suspend ()
   (interactive)
   (run-hooks 'wl-folder-suspend-hook)