-;;; 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)
(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)
(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)
(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))
;;; (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)))
(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)
(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)
(read-from-minibuffer
(if access "Access Type Group: " "Group: ")))))
;; To check the folder name is correct.
- (elmo-make-folder group)
+ (if access (elmo-make-folder group))
(when (or access (string-match "[\t ]*/$" group))
(setq group (if access group
(substring group 0 (match-beginning 0))))
(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)
projects / elisp / wanderlust.git / blobdiff