X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-fldmgr.el;h=fb5b1359b3d85392a26fa267c1edd497b86d1d7b;hb=a188e316446f771a0900c8e05026e39b224eb0f9;hp=b5729308001171691917bdb95c6db67dbad538ff;hpb=059830feabe75e11d8e64dfc670915a6c09a51bf;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el
index b572930..fb5b135 100644
--- a/wl/wl-fldmgr.el
+++ b/wl/wl-fldmgr.el
@@ -51,6 +51,9 @@
 # Folder definition file
 # This file is generated automatically by %s.
 #
+# If you edit this file by hand, be sure that comment lines
+# will be washed out by wl-fldmgr.
+#
 
 " (product-string-1 'wl-version t)))
 
@@ -384,11 +387,11 @@ return value is diffs '(-new -unread -all)."
 	    (cond
 	     ((stringp (car new2)) ;; folder
 	      (cond
-	       ((wl-string-member (car new2) flist)
+	       ((elmo-string-member (car new2) flist)
 		(and errmes (message "%s: already exists" (car new2)))
 		(throw 'success nil))
 	       ((and access
-		     (not (wl-string-member (car new2) unsubscribes)))
+		     (not (elmo-string-member (car new2) unsubscribes)))
 		(and errmes (message "%s: not access group folder" (car new2)))
 		(throw 'success nil))))
 	     (t			   ;; group
@@ -458,6 +461,7 @@ return value is diffs '(-new -unread -all)."
 ;;;			 (wl-fldmgr-get-entity-id (cdr previous-entity))))))
 	(wl-folder-prev-entity-skip-invalid))
       (if (and prev
+	       (wl-folder-buffer-group-p)
 	       (looking-at wl-folder-group-regexp)
 	       (string= (wl-match-buffer 2) "-"))
 	  (setq group-target nil)
@@ -593,7 +597,8 @@ return value is diffs '(-new -unread -all)."
 		    (wl-delete-entity path nil wl-folder-entity clear)))
 	  (setq wl-fldmgr-modified t)
 	  ;;
-	  (if (looking-at wl-folder-group-regexp)
+	  (if (and (wl-folder-buffer-group-p)
+		   (looking-at wl-folder-group-regexp))
 	      ;; group
 	      (let (beg end indent opened)
 		(setq indent (wl-match-buffer 1))
@@ -647,7 +652,7 @@ return value is diffs '(-new -unread -all)."
 	(while (< (point) to)
 	  (and (looking-at "^\\([ ]*\\)")
 	       (setq indent (wl-match-buffer 1)))
-	  (if (looking-at wl-folder-group-regexp)
+	  (if (wl-folder-buffer-group-p)
 	      (progn
 		(setq errmes "can't copy group folder")
 		(throw 'err t)))
@@ -685,7 +690,7 @@ return value is diffs '(-new -unread -all)."
     (beginning-of-line)
     (let ((ret-val nil))
       (if (and (not ename)
-	       (looking-at wl-folder-group-regexp))
+	       (wl-folder-buffer-group-p))
 	  (message "Can't copy group folder")
 	(let* ((name (or ename (wl-folder-get-entity-from-buffer)))
 	       (entity (elmo-string name)))
@@ -796,12 +801,13 @@ return value is diffs '(-new -unread -all)."
 			(condition-case nil
 			    (wl-fldmgr-add-completion-all-completions string)
 			  (error nil))))))))
-    (if (null flag)
-	(try-completion string table predicate)
-      (if (eq flag 'lambda)
-	  (eq t (try-completion string table predicate))
-	(if flag
-	    (all-completions string table predicate))))))
+    (cond
+     ((null flag)
+      (try-completion string table predicate))
+     ((eq flag 'lambda)
+      (eq t (try-completion string table predicate)))
+     (t
+      (all-completions string table predicate)))))
 
 (defun wl-fldmgr-add (&optional name)
   (interactive)
@@ -809,7 +815,7 @@ return value is diffs '(-new -unread -all)."
     (beginning-of-line)
     (let ((ret-val nil)
 	  (inhibit-read-only t)
-	  (wl-folder-completion-function
+	  (wl-folder-complete-folder-candidate
 	   (if wl-fldmgr-add-complete-with-current-folder-list
 	       (function wl-fldmgr-add-completion-subr)))
 	  tmp indent path diffs)
@@ -839,20 +845,13 @@ return value is diffs '(-new -unread -all)."
   (interactive)
   (save-excursion
     (beginning-of-line)
-    (if (looking-at wl-folder-group-regexp)
+    (if (wl-folder-buffer-group-p)
 	(error "Can't delete group folder"))
     (let* ((inhibit-read-only t)
 	   (tmp (wl-fldmgr-get-path-from-buffer))
 	   (entity (elmo-string (nth 4 tmp)))
-	   (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-folder-delete folder)
+	   (folder (wl-folder-get-elmo-folder entity)))
+      (when (elmo-folder-delete folder)
 	(wl-fldmgr-cut tmp nil t)))))
 
 (defun wl-fldmgr-rename ()
@@ -862,9 +861,10 @@ return value is diffs '(-new -unread -all)."
     (if (bobp)
 	(message "Can't rename desktop group")
       (cond
-       ((looking-at wl-folder-group-regexp) ;; group
+       ((and (wl-folder-buffer-group-p)
+	     (looking-at wl-folder-group-regexp)) ;; group
 	(let* ((indent (wl-match-buffer 1))
-	       (old-group (wl-folder-get-realname (wl-match-buffer 3)))
+	       (old-group (wl-folder-get-entity-from-buffer))
 	       (group-entity (wl-folder-search-group-entity-by-name
 			      old-group wl-folder-entity))
 	       group)
@@ -900,6 +900,7 @@ return value is diffs '(-new -unread -all)."
 	(let* ((tmp (wl-fldmgr-get-path-from-buffer))
 	       (old-folder (nth 4 tmp))
 	       new-folder)
+	  (unless old-folder (error "No folder"))
 	  (setq new-folder
 		(wl-fldmgr-read-string
 		 (wl-summary-read-folder old-folder "to rename" t t old-folder)))
@@ -919,6 +920,7 @@ return value is diffs '(-new -unread -all)."
 	   new-folder
 	   (wl-folder-get-entity-info old-folder))
 	  (wl-folder-clear-entity-info old-folder)
+	  (setq wl-folder-info-alist-modified t)
 	  (if (eq (cdr (nth 2 tmp)) 'access)
 
 	      ;; force update access group
@@ -1035,24 +1037,25 @@ return value is diffs '(-new -unread -all)."
 				wl-fldmgr-make-filter-default)
 			       "/" entity))))))
 
-(defun wl-fldmgr-sort ()
-  (interactive)
+(defun wl-fldmgr-sort (&optional arg)
+  (interactive "P")
   (save-excursion
     (beginning-of-line)
     (let ((inhibit-read-only t)
 	  entity flist indent opened)
-      (when (looking-at wl-folder-group-regexp)
+      (when (and (wl-folder-buffer-group-p)
+		 (looking-at wl-folder-group-regexp))
 	(setq indent (wl-match-buffer 1))
 	(setq opened (wl-match-buffer 2))
 	(setq entity (wl-folder-search-group-entity-by-name
-		      (wl-folder-get-realname (wl-match-buffer 3))
+		      (wl-folder-get-entity-from-buffer)
 		      wl-folder-entity))
 	(message "Sorting...")
 	(setq flist (sort (nth 2 entity) wl-fldmgr-sort-function))
+	(when arg (setq flist (nreverse flist)))
 	(setcar (cddr entity) flist)
 	(wl-fldmgr-add-modified-access-list (car entity))
 	(setq wl-fldmgr-modified t)
-	;;
 	(when (string= opened "-")
 	  (let (beg end)
 	    (setq beg (point))
@@ -1065,7 +1068,6 @@ return value is diffs '(-new -unread -all)."
 		      (point))))
 	    (delete-region beg end)
 	    (wl-folder-insert-entity indent entity)))
-;;;	(wl-fldmgr-reconst-entity-hashtb t t)
 	(message "Sorting...done")
 	(set-buffer-modified-p nil)))))
 
@@ -1145,12 +1147,13 @@ return value is diffs '(-new -unread -all)."
 	 (t
 	  (if (and type (< type 0))
 	      nil
-	    (setq is-group (looking-at wl-folder-group-regexp))
+	    (setq is-group (wl-folder-buffer-group-p))
 	    (setq tmp (wl-fldmgr-get-path-from-buffer))
 	    (setq indent (wl-fldmgr-make-indent (nth 1 tmp)))
 	    (if (eq (cdr (nth 2 tmp)) 'access)
 		(when (wl-fldmgr-cut tmp)
-		  (pop wl-fldmgr-cut-entity-list)  ;; don't leave cut-list
+		  ;; don't leave cut-list
+		  (setq wl-fldmgr-cut-entity-list (cdr wl-fldmgr-cut-entity-list))
 		  (setq beg (point))
 		  (insert indent wl-folder-unsubscribe-mark
 			  (if is-group
@@ -1181,13 +1184,15 @@ return value is diffs '(-new -unread -all)."
     (let ((inhibit-read-only t)
 	  entity indent opened
 	  unsubscribes beg)
-      (when (not (looking-at wl-folder-group-regexp))
+      (when (not
+	     (and (wl-folder-buffer-group-p)
+		  (looking-at wl-folder-group-regexp)))
 	(wl-folder-goto-top-of-current-folder)
 	(looking-at wl-folder-group-regexp))
       (setq indent (wl-match-buffer 1))
       (setq opened (wl-match-buffer 2))
       (setq entity (wl-folder-search-group-entity-by-name
-		    (wl-folder-get-realname (wl-match-buffer 3))
+		    (wl-folder-get-entity-from-buffer)
 		    wl-folder-entity))
       (when (eq (nth 1 entity) 'access)
 	(save-excursion
@@ -1226,7 +1231,7 @@ return value is diffs '(-new -unread -all)."
   (interactive)
   (save-excursion
     (beginning-of-line)
-      (let* ((is-group (looking-at wl-folder-group-regexp))
+      (let* ((is-group (wl-folder-buffer-group-p))
 	     (name (wl-folder-get-entity-from-buffer))
 	     (searchname (wl-folder-get-petname name))
 	     (pentry (wl-string-assoc name wl-folder-petname-alist))
@@ -1300,10 +1305,8 @@ return value is diffs '(-new -unread -all)."
 		       "")
 		     "\n"))
 	    ((consp name)
-	     (let ((group (wl-folder-get-realname (car name)))
+	     (let ((group (car name))
 		   (type (nth 1 name)))
-	       (if (not (string= group (car name))) ; petname.
-		   (wl-append pet-entities (list (car name))))
 	       (cond ((eq type 'group)
 		      (insert indent group "{\n")
 		      (setq pet-entities
@@ -1345,7 +1348,7 @@ return value is diffs '(-new -unread -all)."
     (wl-fldmgr-delete-disused-petname)
     (setq save-petname-entities
 	  (wl-fldmgr-insert-folders-buffer "" (nth 2 wl-folder-entity)))
-    (insert "\n# petname definition (group, folder in access group)\n")
+    (insert "\n# petname definition (access group, folder in access group)\n")
     (wl-fldmgr-insert-petname-buffer save-petname-entities)
     (insert "\n# end of file.\n")
     (if (and wl-fldmgr-make-backup