# 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)))
(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
;;; (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)
(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))
(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)))
(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)))
(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)
(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)
(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 ()
(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)
(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)))
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)
(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))
(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)))))
(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
(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
(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))
"")
"\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
(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
projects / elisp / wanderlust.git / blobdiff