X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-fldmgr.el;h=fb5b1359b3d85392a26fa267c1edd497b86d1d7b;hb=8a81d3a3caef0f94f9721361a749f0b6429f30ce;hp=197528543533f41609981e4e456f7cc82629d1a3;hpb=8f69384e4b4dc241a3990d49b9f2674eb0b717b6;p=elisp%2Fwanderlust.git diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 1975285..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,13 +920,14 @@ 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 (progn (wl-folder-open-close) (wl-folder-jump-to-current-entity t) - (message (format "%s is renamed to %s" new-folder old-folder)) + (message "%s is renamed to %s" old-folder new-folder) (sit-for 1)) ;; update folder list (when (wl-fldmgr-cut tmp nil t) @@ -1015,37 +1017,45 @@ 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))))))) - -(defun wl-fldmgr-sort () - (interactive) + (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 (&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)) @@ -1058,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))))) @@ -1138,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 @@ -1174,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 @@ -1219,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)) @@ -1293,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 @@ -1338,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