X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-fldmgr.el;h=b5729308001171691917bdb95c6db67dbad538ff;hb=167053919d525e30162c34e574b6452bb858211b;hp=b08ee3892440b7cc5d25011561173363000f01a8;hpb=0fbd8fa3e611a5f03687ff7e11f98083d67bc1ce;p=elisp%2Fwanderlust.git diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index b08ee38..b572930 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -751,57 +751,57 @@ return value is diffs '(-new -unread -all)." (defvar wl-fldmgr-add-completion-hashtb (make-vector 7 0)) -;(defun wl-fldmgr-add-completion-all-completions (string) -; (let ((table -; (catch 'found -; (mapatoms -; (function -; (lambda (atom) -; (if (string-match (symbol-name atom) string) -; (throw 'found (symbol-value atom))))) -; wl-fldmgr-add-completion-hashtb))) -; (pattern -; (if (string-match "\\.$" -; (car (elmo-network-get-spec -; string nil nil nil nil))) -; (substring string 0 (match-beginning 0)) -; (concat string nil)))) -; (or table -; (setq table (elmo-folder-list-subfolders (wl-folder-get-elmo-folder -; pattern))) -; (and table -; (or (/= (length table) 1) -; (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-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)) -; table)) - -;(defun wl-fldmgr-add-completion-subr (string predicate flag) -; (let ((table -; (if (string= string "") -; (mapcar (function (lambda (spec) -; (list (char-to-string (car spec))))) -; elmo-spec-alist) -; (when (assq (aref string 0) elmo-spec-alist) -; (delq nil (mapcar -; (function list) -; (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)))))) +(defun wl-fldmgr-add-completion-all-completions (string) + (let ((table + (catch 'found + (mapatoms + (function + (lambda (atom) + (if (string-match (symbol-name atom) string) + (throw 'found (symbol-value atom))))) + wl-fldmgr-add-completion-hashtb))) + (pattern + (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-folder-list-subfolders + (wl-folder-get-elmo-folder pattern))) + (and table + (or (/= (length table) 1) + (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-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)) + table)) + +(defun wl-fldmgr-add-completion-subr (string predicate flag) + (let ((table + (if (string= string "") + (mapcar (function (lambda (spec) + (list (char-to-string (car spec))))) + elmo-folder-type-alist) + (when (assq (aref string 0) elmo-folder-type-alist) + (delq nil (mapcar + (function list) + (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)))))) (defun wl-fldmgr-add (&optional name) (interactive) @@ -900,8 +900,6 @@ return value is diffs '(-new -unread -all)." (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))) @@ -909,13 +907,29 @@ return value is diffs '(-new -unread -all)." (file-exists-p (elmo-folder-msgdb-path (wl-folder-get-elmo-folder new-folder)))) (error "Already exists folder: %s" 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) @@ -1001,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)