-;;; 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>
;; Author: Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news
-;; Time-stamp: <00/03/14 19:34:28 teranisi>
;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'wl-folder)
(require 'wl-summary)
(require 'wl-highlight)
+(require 'wl-version)
(eval-when-compile
(require 'wl-util))
(defvar wl-fldmgr-group-insert-opened nil)
(defconst wl-fldmgr-folders-header
- "#
+ (format
+ "#
# Folder definition file
-# This file is generated automatically by %s %s (%s).
+# 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.
#
-")
-
-(defconst wl-fldmgr-filter-completion-alist
- '(("/last:")
- ("/first:")
- ("/since:")
- ("/before:")
- ("/from=")
- ("/subject=")
- ("/date=")
- ("/to=")
- ("/cc=")
- ("/tocc=")
- ("/body=")))
+" (product-string-1 'wl-version t)))
;;; Initial setup
(defun wl-fldmgr-exit ()
(when (and wl-fldmgr-modified
(or (not wl-interactive-save-folders)
- (y-or-n-p "Folder view was modified. Save current folders? ")))
+ (y-or-n-p
+ (concat "Folder view was modified"
+ (and wl-fldmgr-cut-entity-list
+ (format " (%s in cut stack)"
+ (length wl-fldmgr-cut-entity-list)))
+ ". Save current folders? "))))
(wl-fldmgr-save-folders)))
;;; Macro and misc Function
(defmacro wl-fldmgr-assign-id (entity &optional id)
(` (let ((entity-id (or (, id) wl-folder-entity-id)))
(put-text-property 0 (length (, entity))
- 'wl-folder-entity-id
+ 'wl-folder-entity-id
entity-id
(, entity)))))
wl-folder-group-alist)))
(defun wl-fldmgr-add-entity-hashtb (entities)
- "update `wl-folder-entity-hashtb', `wl-folder-newsgroups-hashtb'.
-return value is diffs '(new unread all)."
+ "Update `wl-folder-entity-hashtb', `wl-folder-newsgroups-hashtb'.
+Return value is diffs '(new unread all)."
(let* ((new-diff 0)
(unread-diff 0)
(all-diff 0)
(list new-diff unread-diff all-diff)))
(defun wl-fldmgr-delete-entity-hashtb (entities &optional clear)
- "update `wl-folder-entity-hashtb'.
+ "Update `wl-folder-entity-hashtb'.
return value is diffs '(-new -unread -all)."
(let* ((new-diff 0)
(unread-diff 0)
;; (defun wl-fldmgr-get-previous-entity (entity key-id)
;; (cdr (wl-fldmgr-get-previous-entity-internal '(nil . nil) entity key-id)))
-;;
+;;
;; (defun wl-fldmgr-get-previous-entity-internal (result entity key-id)
;; (cond
;; ((stringp entity)
(message "%s not found" key)
(setq update nil)
(throw 'done t)))
- (when access
+ (when (and access (not clear))
(if is-group
(wl-append unsubscribes
(list (list (elmo-string key) 'access nil)))
(defun wl-add-entity (key-path new entity prev-entity-id &optional errmes)
(when (string= (caar key-path) (car entity))
- (mapcar
- '(lambda (ent)
+ (let ((entities new))
+ (while entities
(wl-folder-entity-assign-id
- ent
- wl-folder-entity-id-name-hashtb
- t))
- new)
+ (pop entities) wl-folder-entity-id-name-hashtb t)))
(when (wl-add-entity-sub (cdr key-path) new entity errmes)
;; return value is non-nil (diffs)
(wl-fldmgr-add-entity-hashtb new))))
(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
;; do it
(when access
;; remove from unsubscribe
- (mapcar
- '(lambda (x)
- (cond
- ((consp x)
+ (setq new2 new)
+ (while new2
+ (if (consp (car new2))
(setq unsubscribes
- (delete (wl-string-assoc (car x) unsubscribes)
- unsubscribes)))
- (t
- (setq unsubscribes (delete (elmo-string x) unsubscribes)))))
- new)
-;; (setq new2 new)
-;; (while new2
-;; (setq unsubscribes (delete (elmo-string (car new2)) unsubscribes))
-;; (setq new2 (cdr new2)))
- (setcdr (cddr entity) (list unsubscribes))
+ (delq (wl-string-assoc (car (car new2)) unsubscribes)
+ unsubscribes))
+ (setq unsubscribes (delete (elmo-string (car new2))
+ unsubscribes)))
+ (setq new2 (cdr new2)))
+ (setcdr (cddr entity) (list unsubscribes))
(wl-fldmgr-add-modified-access-list group))
(if (not key-path);; insert group top
(if (cddr entity)
;; return value is
;; (path indent-level (group . type) previous-entity-id target-entity)
;; previous-entity-id is (id-name-alist-prev-id . entity-alist-prev-id)
-;; example:
+;; example:
;; '((("Desktop" group) ("ML" group) "+ml/wl") '(3 2) ("ML" . group) nil "+ml/wl")
(defun wl-fldmgr-get-path-from-buffer (&optional prev)
(save-excursion
(beginning-of-line)
(when prev
-;; (wl-folder-next-entity-skip-invalid t)
-;; (and (setq previous-entity
-;; (wl-fldmgr-get-previous-entity wl-folder-entity
-;; (wl-fldmgr-get-entity-id)))
-;; ;; change entity to id
-;; (setq previous-entity
-;; (cons
-;; (and (car previous-entity)
-;; (wl-fldmgr-get-entity-id (car previous-entity)))
-;; (and (cdr previous-entity)
-;; (wl-fldmgr-get-entity-id (cdr previous-entity))))))
+;;; (wl-folder-next-entity-skip-invalid t)
+;;; (and (setq previous-entity
+;;; (wl-fldmgr-get-previous-entity wl-folder-entity
+;;; (wl-fldmgr-get-entity-id)))
+;;; ;; change entity to id
+;;; (setq previous-entity
+;;; (cons
+;;; (and (car previous-entity)
+;;; (wl-fldmgr-get-entity-id (car previous-entity)))
+;;; (and (cdr previous-entity)
+;;; (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)
(if (and prev (bobp))
- (error "out of desktop group")))
+ (error "Out of desktop group")))
(setq folder-path (wl-fldmgr-get-path wl-folder-entity
(wl-folder-get-entity-from-buffer)
- ;;(wl-fldmgr-get-entity-id)
+;;; (wl-fldmgr-get-entity-id)
group-target))
(let ((fp folder-path))
(while fp
(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)))
wl-fldmgr-add-completion-hashtb)))
(pattern
(if (string-match "\\.$"
- (car (elmo-network-get-spec
- string nil nil nil)))
+ (elmo-folder-prefix-internal
+ (wl-folder-get-elmo-folder string)))
(substring string 0 (match-beginning 0))
(concat string nil))))
(or table
- (setq table (elmo-list-folders pattern))
+ (setq table (elmo-folder-list-subfolders
+ (wl-folder-get-elmo-folder pattern)))
(and table
(or (/= (length table) 1)
- (elmo-folder-exists-p (car table))))
+ (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-list-folders pattern)))
+ 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))
(if (string= string "")
(mapcar (function (lambda (spec)
(list (char-to-string (car spec)))))
- elmo-spec-alist)
- (when (assq (aref string 0) elmo-spec-alist)
+ 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))))))
+ (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-func (function wl-fldmgr-add-completion-subr))
+ (wl-folder-complete-folder-candidate
+ (if wl-fldmgr-add-complete-with-current-folder-list
+ (function wl-fldmgr-add-completion-subr)))
tmp indent path diffs)
(if (bobp)
(message "Can't insert in the out of desktop group")
(setq name (wl-fldmgr-read-string
(wl-summary-read-folder wl-default-folder "to add"))))
;; maybe add elmo-plugged-alist.
- (when (stringp name)
- (elmo-folder-set-plugged 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))
(interactive)
(save-excursion
(beginning-of-line)
- (if (looking-at wl-folder-group-regexp)
- (error "can't delete group folder"))
+ (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)))
- (msgs (and (elmo-folder-exists-p entity)
- (elmo-list-folder entity))))
- (when (yes-or-no-p (format "%sDo you really delete \"%s\"? "
- (if (> (length msgs) 0)
- (format "%d msg(s) exists. " (length msgs))
- "")
- entity))
- (elmo-delete-folder entity)
- (wl-fldmgr-cut tmp nil t)))))
+ (folder (wl-folder-get-elmo-folder entity)))
+ (when (elmo-folder-delete folder)
+ (wl-folder-clear-entity-info entity)
+ (wl-fldmgr-cut tmp nil t)
+ (wl-fldmgr-save-access-list)))))
(defun wl-fldmgr-rename ()
(interactive)
(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)))
- (group-entity (wl-folder-search-group-entity-by-name
+ (old-group (wl-folder-get-entity-from-buffer))
+ (group-entity (wl-folder-search-group-entity-by-name
old-group wl-folder-entity))
group)
(if (eq (nth 1 group-entity) 'access)
(setcar group-entity group)
(setcar (wl-string-assoc old-group wl-folder-group-alist)
group)
- ;;(setcdr (assq id wl-folder-entity-id-name-alist) group)
+;;; (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"))
+ (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)))
(if (or (wl-folder-entity-exists-p new-folder)
- (file-exists-p (elmo-msgdb-expand-path new-folder)))
- (error "already exists folder: %s" new-folder))
- (elmo-rename-folder old-folder new-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)
+ (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 "%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)
(message "Can't insert access group")
(setq group (or group-name
(wl-fldmgr-read-string
- (read-from-minibuffer
+ (read-from-minibuffer
(if access "Access Type Group: " "Group: ")))))
+ ;; To check the folder name is correct.
+ (if access (elmo-make-folder group))
(when (or access (string-match "[\t ]*/$" group))
(setq group (if access group
(substring group 0 (match-beginning 0))))
(message "Can't make multi included group folder")
(throw 'done nil))
(t
- (let ((spec (elmo-folder-get-spec (car cut-entity)))
+ (let ((folder (wl-folder-get-elmo-folder
+ (car cut-entity)))
multi-fld)
- (if (eq (car spec) 'multi)
+ (if (eq (elmo-folder-type-internal folder) 'multi)
(setq multi-fld
(substring (car cut-entity) 1)))
(setq new-entity
(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)))
- (if (eq (cdr (nth 2 tmp)) 'access)
- (message "Tan't change access group")
- (let* ((entity (nth 4 tmp))
- (old-entity entity)
- old-filter
- filter new-entity)
- (unless entity (error "no folder"))
- (when (string-match "^\\(\\(/[^/]+/\\)+\\)\\(.*\\)" entity)
- (setq old-filter (substring entity
- (match-beginning 1)
- (match-end 1)))
- (setq old-entity (substring entity
- (match-beginning 3)
- (match-end 3))))
- (setq filter (completing-read "Filter: "
- wl-fldmgr-filter-completion-alist
- nil nil
- (or old-filter "/")))
- (unless (or (string= filter "")
- (string-match "/$" filter))
- (setq filter (concat filter "/")))
- (setq new-entity (concat filter old-entity))
- (let ((entity new-entity)
- spec)
- ;; check filter syntax
- (while (eq
- (car (setq spec (elmo-folder-get-spec entity)))
- 'filter)
- (setq entity (nth 2 spec))))
- (wl-fldmgr-add new-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)
+ (prog1
+ (y-or-n-p (format "Sort subfolders of %s? "
+ (wl-folder-get-entity-from-buffer)))
+ (message nil)))
(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-func))
+ (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)))))
(wl-fldmgr-delete-line)
(when (wl-fldmgr-add folder)
(wl-folder-maybe-load-folder-list folder)
-;; (wl-folder-search-group-entity-by-name (car folder)
-;; wl-folder-entity))
+;;; (wl-folder-search-group-entity-by-name (car folder)
+;;; wl-folder-entity)
(setq execed t)))))
((looking-at (format "^[ ]*%s\\(.*\\)" wl-folder-unsubscribe-mark))
(if (and type (> type 0))
(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
(save-excursion (forward-line -1)
(wl-highlight-folder-current-line))
(remove-text-properties beg (point) '(wl-folder-entity-id))
- (setq execed t))))))
+ (setq execed t))
+ (message "not an access group folder")))))
(set-buffer-modified-p nil)))
(if (or force execed)
(progn
(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))
(old-petname (or (cdr pentry) ""))
(change)
petname)
- (unless name (error "no folder"))
+ (unless name (error "No folder"))
(if (and is-group
(not (eq (nth 1 (wl-folder-search-group-entity-by-name
name wl-folder-entity))
(if (string= petname old-petname)
nil
(if (or (rassoc petname wl-folder-petname-alist)
- (wl-string-assoc petname wl-folder-group-alist))
+ (and is-group
+ (wl-string-assoc petname wl-folder-group-alist)))
(message "%s: already exists" petname)
(wl-folder-append-petname name petname)
(setq change t)))))
(progn
(if (string= old-petname "")
(setq old-petname name))
- (while (wl-folder-buffer-search-group old-petname)
- (beginning-of-line)
+ (while (wl-folder-buffer-search-group old-petname)
+ (beginning-of-line)
(and (looking-at "^\\([ ]*\\)")
(setq indent (wl-match-buffer 1)))
(wl-fldmgr-delete-line)
(wl-folder-insert-entity
indent
- (wl-folder-search-group-entity-by-name
- name wl-folder-entity)
+ (wl-folder-search-group-entity-by-name
+ name wl-folder-entity)
t)))
(while (wl-folder-buffer-search-entity name searchname)
(save-excursion
- (beginning-of-line)
+ (beginning-of-line)
(and (looking-at "^\\([ ]*\\)")
(setq indent (wl-match-buffer 1)))
(wl-fldmgr-delete-line))
"")
"\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
(defun wl-fldmgr-save-folders ()
(interactive)
(let ((tmp-buf (get-buffer-create " *wl-fldmgr-tmp*"))
- (access-list wl-fldmgr-modified-access-list)
- entity
save-petname-entities)
(message "Saving folders...")
(set-buffer tmp-buf)
(erase-buffer)
- (insert (format wl-fldmgr-folders-header
- wl-appname wl-version wl-codename))
+ (insert wl-fldmgr-folders-header)
(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
(file-exists-p wl-folders-file))
(rename-file wl-folders-file (concat wl-folders-file ".bak") t))
- (let ((output-coding-system (mime-charset-to-coding-system
+ (let ((output-coding-system (mime-charset-to-coding-system
wl-mime-charset)))
(write-region
(point-min)
wl-folders-file
nil
'no-msg)
- (set-file-modes wl-folders-file 384)) ; 600
+ (set-file-modes wl-folders-file (+ (* 64 6) (* 8 0) 0))) ; chmod 0600
(kill-buffer tmp-buf)
+ (wl-fldmgr-save-access-list)
+ (setq wl-fldmgr-modified nil)
+ (message "Saving folders...done")))
+
+(defun wl-fldmgr-save-access-list ()
+ (let ((access-list wl-fldmgr-modified-access-list)
+ entity)
(while access-list
(setq entity (wl-folder-search-group-entity-by-name
(car access-list) wl-folder-entity))
(wl-folder-make-save-access-list (nth 2 entity))
(wl-folder-make-save-access-list (nth 3 entity))))
(setq access-list (cdr access-list)))
- (setq wl-fldmgr-modified nil)
- (setq wl-fldmgr-modified-access-list nil)
- (message "Saving folders...done")))
+ (setq wl-fldmgr-modified-access-list nil)))
-(provide 'wl-fldmgr)
+(require 'product)
+(product-provide (provide 'wl-fldmgr) (require 'wl-version))
;;; wl-fldmgr.el ends here