* wl-draft.el (wl-draft-create-contents): Fix docstring.
[elisp/wanderlust.git] / wl / wl-fldmgr.el
index 5379a7c..b572930 100644 (file)
@@ -1,4 +1,4 @@
-;;; wl-fldmgr.el -- Folder manager for Wanderlust.
+;;; wl-fldmgr.el --- Folder manager for Wanderlust.
 
 ;; Copyright 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
 ;;                          Yuuichi Teranishi <teranisi@gohome.org>
 ;;
 
 ;;; Commentary:
-;; 
+;;
 
 ;;; Code:
-;; 
+;;
 
 (require 'wl-folder)
 (require 'wl-summary)
@@ -52,7 +52,7 @@
 # This file is generated automatically by %s.
 #
 
-" (wl-version t)))
+" (product-string-1 'wl-version t)))
 
 ;;; Initial setup
 
@@ -410,7 +410,7 @@ return value is diffs '(-new -unread -all)."
                (setq unsubscribes (delete (elmo-string (car new2))
                                           unsubscribes)))
              (setq new2 (cdr new2)))
-           (setcdr (cddr entity) (list unsubscribes))
+           (setcdr (cddr entity) (list unsubscribes))
            (wl-fldmgr-add-modified-access-list group))
          (if (not key-path);; insert group top
              (if (cddr entity)
@@ -761,21 +761,24 @@ return value is diffs '(-new -unread -all)."
                   (throw 'found (symbol-value atom)))))
            wl-fldmgr-add-completion-hashtb)))
        (pattern
-        (if (string-match "\\.$"
-                          (car (elmo-network-get-spec
-                                string nil nil nil nil)))
+        (if (string-match "\\.$" 
+                          (elmo-folder-prefix-internal
+                           (wl-folder-get-elmo-folder string)))
             (substring string 0 (match-beginning 0))
           (concat string nil))))
     (or table
-       (setq table (elmo-list-folders pattern))
+       (setq table (elmo-folder-list-subfolders
+                    (wl-folder-get-elmo-folder pattern)))
        (and table
             (or (/= (length table) 1)
-                (elmo-folder-exists-p (car table))))
+                (elmo-folder-exists-p (wl-folder-get-elmo-folder
+                                       (car table)))))
        (setq pattern
              (if (string-match "\\.[^\\.]+$" string)
                  (substring string 0 (match-beginning 0))
                (char-to-string (aref string 0)))
-             table (elmo-list-folders pattern)))
+             table (elmo-folder-list-subfolders
+                    (wl-folder-get-elmo-folder pattern))))
     (setq pattern (concat "^" (regexp-quote pattern)))
     (unless (intern-soft pattern wl-fldmgr-add-completion-hashtb)
       (set (intern pattern wl-fldmgr-add-completion-hashtb) table))
@@ -786,8 +789,8 @@ return value is diffs '(-new -unread -all)."
         (if (string= string "")
             (mapcar (function (lambda (spec)
                                 (list (char-to-string (car spec)))))
-                    elmo-spec-alist)
-          (when (assq (aref string 0) elmo-spec-alist)
+                    elmo-folder-type-alist)
+          (when (assq (aref string 0) elmo-folder-type-alist)
             (delq nil (mapcar
                        (function list)
                        (condition-case nil
@@ -806,7 +809,7 @@ return value is diffs '(-new -unread -all)."
     (beginning-of-line)
     (let ((ret-val nil)
          (inhibit-read-only t)
-         (wl-folder-completion-func
+         (wl-folder-completion-function
           (if wl-fldmgr-add-complete-with-current-folder-list
               (function wl-fldmgr-add-completion-subr)))
          tmp indent path diffs)
@@ -819,8 +822,9 @@ return value is diffs '(-new -unread -all)."
            (setq name (wl-fldmgr-read-string
                        (wl-summary-read-folder wl-default-folder "to add"))))
        ;; maybe add elmo-plugged-alist.
-       (when (stringp name)
-         (elmo-folder-set-plugged name wl-plugged t))
+       (elmo-folder-set-plugged (wl-folder-get-elmo-folder
+                                 (if (listp name) (car name) name))
+                                wl-plugged t)
        (when (setq diffs
                    (wl-add-entity
                     path (list name) wl-folder-entity (nth 3 tmp) t))
@@ -840,14 +844,15 @@ return value is diffs '(-new -unread -all)."
     (let* ((inhibit-read-only t)
           (tmp (wl-fldmgr-get-path-from-buffer))
           (entity (elmo-string (nth 4 tmp)))
-          (msgs (and (elmo-folder-exists-p entity)
-                     (elmo-list-folder entity))))
-      (when (yes-or-no-p (format "%sDo you really delete \"%s\"? "
+          (folder (wl-folder-get-elmo-folder entity))
+          (msgs (and (elmo-folder-exists-p folder)
+                     (elmo-folder-list-messages folder))))
+      (when (yes-or-no-p (format "%sDo you really want to delete \"%s\"? "
                                 (if (> (length msgs) 0)
                                     (format "%d msg(s) exists. " (length msgs))
                                   "")
                                 entity))
-       (elmo-delete-folder entity)
+       (elmo-folder-delete folder)
        (wl-fldmgr-cut tmp nil t)))))
 
 (defun wl-fldmgr-rename ()
@@ -886,29 +891,45 @@ return value is diffs '(-new -unread -all)."
 ;;;                (setcdr (assq id wl-folder-entity-id-name-alist) group)
                    (wl-folder-set-id-name id group)
                    (wl-fldmgr-delete-line)
-                   (wl-folder-insert-entity
-                    indent
-                    group-entity t)
+                   (wl-folder-insert-entity
+                    indent
+                    group-entity t)
                    (setq wl-fldmgr-modified t)
                    (set-buffer-modified-p nil)))))))))
        (t ;; folder
        (let* ((tmp (wl-fldmgr-get-path-from-buffer))
               (old-folder (nth 4 tmp))
               new-folder)
-         (if (eq (cdr (nth 2 tmp)) 'access)
-             (error "Can't rename access folder"))
          (setq new-folder
                (wl-fldmgr-read-string
                 (wl-summary-read-folder old-folder "to rename" t t old-folder)))
          (if (or (wl-folder-entity-exists-p new-folder)
-                 (file-exists-p (elmo-msgdb-expand-path new-folder)))
+                 (file-exists-p (elmo-folder-msgdb-path
+                                 (wl-folder-get-elmo-folder new-folder))))
              (error "Already exists folder: %s" new-folder))
-         (elmo-rename-folder old-folder new-folder)
+         (if (and (eq (cdr (nth 2 tmp)) 'access)
+                  (null wl-fldmgr-allow-rename-access-group)
+                  (null (string-match
+                         (format "^%s" (regexp-quote (car (nth 2 tmp))))
+                         new-folder)))
+             (error "Can't rename access folder"))
+         (elmo-folder-rename (wl-folder-get-elmo-folder old-folder)
+                             new-folder)
          (wl-folder-set-entity-info
           new-folder
           (wl-folder-get-entity-info old-folder))
-         (when (wl-fldmgr-cut tmp nil t)
-           (wl-fldmgr-add new-folder))))))))
+         (wl-folder-clear-entity-info old-folder)
+         (if (eq (cdr (nth 2 tmp)) 'access)
+
+             ;; force update access group
+             (progn
+               (wl-folder-open-close)
+               (wl-folder-jump-to-current-entity t)
+               (message "%s is renamed to %s" old-folder new-folder)
+               (sit-for 1))
+           ;; update folder list
+           (when (wl-fldmgr-cut tmp nil t)
+             (wl-fldmgr-add new-folder)))))))))
 
 (defun wl-fldmgr-make-access-group ()
   (interactive)
@@ -924,7 +945,7 @@ return value is diffs '(-new -unread -all)."
            (type 'group)
            group tmp indent path new prev-id flist diffs)
        (setq tmp (wl-fldmgr-get-path-from-buffer t))
-       (setq path (car tmp))
+       (setq path (car tmp))
        (setq indent (wl-fldmgr-make-indent (nth 1 tmp)))
        (setq prev-id (nth 3 tmp))
        (if (eq (cdr (nth 2 tmp)) 'access)
@@ -933,6 +954,8 @@ return value is diffs '(-new -unread -all)."
                          (wl-fldmgr-read-string
                           (read-from-minibuffer
                            (if access "Access Type Group: " "Group: ")))))
+         ;; To check the folder name is correct.
+         (if access (elmo-make-folder group))
          (when (or access (string-match "[\t ]*/$" group))
            (setq group (if access group
                          (substring group 0 (match-beginning 0))))
@@ -970,9 +993,10 @@ return value is diffs '(-new -unread -all)."
                  (message "Can't make multi included group folder")
                  (throw 'done nil))
                 (t
-                 (let ((spec (elmo-folder-get-spec (car cut-entity)))
+                 (let ((folder (wl-folder-get-elmo-folder
+                                (car cut-entity)))
                        multi-fld)
-                   (if (eq (car spec) 'multi)
+                   (if (eq (elmo-folder-type-internal folder) 'multi)
                        (setq multi-fld
                              (substring (car cut-entity) 1)))
                    (setq new-entity
@@ -991,18 +1015,25 @@ return value is diffs '(-new -unread -all)."
   (interactive)
   (save-excursion
     (beginning-of-line)
-    (if (looking-at wl-folder-group-regexp)
-       (message "This folder is group")
-      (let ((tmp (wl-fldmgr-get-path-from-buffer))
-           entity)
-       (if (eq (cdr (nth 2 tmp)) 'access)
-           (message "Can't change access group")
-         (setq entity (nth 4 tmp))
-         (unless entity (error "No folder"))
-         (wl-fldmgr-add (concat "/"
-                                (elmo-read-search-condition
-                                 wl-fldmgr-make-filter-default)
-                                "/" entity)))))))
+    (let ((tmp (wl-fldmgr-get-path-from-buffer))
+         entity)
+      (if (eq (cdr (nth 2 tmp)) 'access)
+         (message "Can't change access group")
+       (if (wl-folder-buffer-group-p)
+           (setq entity
+                 (concat
+                  "*"
+                  (mapconcat 'identity
+                             (wl-folder-get-entity-list
+                              (wl-folder-search-group-entity-by-name
+                               (nth 4 tmp)
+                               wl-folder-entity)) ",")))
+         (setq entity (nth 4 tmp)))
+       (unless entity (error "No folder"))
+       (wl-fldmgr-add (concat "/"
+                              (elmo-read-search-condition
+                               wl-fldmgr-make-filter-default)
+                              "/" entity))))))
 
 (defun wl-fldmgr-sort ()
   (interactive)
@@ -1017,7 +1048,7 @@ return value is diffs '(-new -unread -all)."
                      (wl-folder-get-realname (wl-match-buffer 3))
                      wl-folder-entity))
        (message "Sorting...")
-       (setq flist (sort (nth 2 entity) wl-fldmgr-sort-func))
+       (setq flist (sort (nth 2 entity) wl-fldmgr-sort-function))
        (setcar (cddr entity) flist)
        (wl-fldmgr-add-modified-access-list (car entity))
        (setq wl-fldmgr-modified t)
@@ -1328,7 +1359,7 @@ return value is diffs '(-new -unread -all)."
        wl-folders-file
        nil
        'no-msg)
-      (set-file-modes wl-folders-file 384)) ; 600
+      (set-file-modes wl-folders-file (+ (* 64 6) (* 8 0) 0))) ; chmod 0600
     (kill-buffer tmp-buf)
     (while access-list
       (setq entity (wl-folder-search-group-entity-by-name