X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-fldmgr.el;h=993fb780dae98cc53850ccea5869758ed857360a;hb=98f38e5383840a86e4ebca5803d505110d0997f8;hp=3c457c5309216657d67775c06cc642fbb735e5a5;hpb=b9db71e3f30336d32f06b30b3500ae133c986f4f;p=elisp%2Fwanderlust.git diff --git a/wl/wl-fldmgr.el b/wl/wl-fldmgr.el index 3c457c5..993fb78 100644 --- a/wl/wl-fldmgr.el +++ b/wl/wl-fldmgr.el @@ -1,4 +1,4 @@ -;;; wl-fldmgr.el -- Folder manager for Wanderlust. +;;; wl-fldmgr.el --- Folder manager for Wanderlust. ;; Copyright 1998,1999,2000 Masahiro MURATA ;; Yuuichi Teranishi @@ -25,10 +25,10 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'wl-folder) (require 'wl-summary) @@ -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) @@ -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) @@ -822,7 +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. - (elmo-folder-set-plugged (wl-folder-get-elmo-folder 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)) @@ -889,17 +891,15 @@ 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))) @@ -907,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) @@ -929,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) @@ -999,21 +1015,28 @@ 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) @@ -1026,10 +1049,10 @@ return value is diffs '(-new -unread -all)." 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)) @@ -1042,7 +1065,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)))))