X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=caa0234161d0bfa6cec3b0987e1ed8c32f2798be;hb=afaaf10e4a3c0333436dd2b6aff450379c557961;hp=835715d22e3f25d2e83c6d3e8ccbeb4d1e4e51c1;hpb=a332b51cafea0174c5f3b308575bf54116f65e9d;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 835715d..caa0234 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -77,7 +77,7 @@ (make-variable-buffer-local 'wl-folder-buffer-cur-point) (defconst wl-folder-entity-regexp "^\\([ ]*\\)\\(\\[[\\+-]\\]\\)?\\([^\\[].+\\):[-*0-9]+/[-*0-9]+/[-*0-9]+") -(defconst wl-folder-group-regexp "^\\([ ]*\\)\\[\\([\\+-]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n") +(defconst wl-folder-group-regexp "^\\([ ]*\\)\\[\\([\\+-]\\)\\]\\(.+\\):[0-9-]+/[0-9-]+/[0-9-]+\n") ;; 1:indent 2:opened 3:group-name (defconst wl-folder-unsync-regexp ":[^0\\*][0-9]*/[0-9\\*-]+/[0-9\\*-]+$") @@ -224,14 +224,14 @@ "Menu used in Folder mode." wl-folder-mode-menu-spec)) -(defmacro wl-folder-unread-regex (group) - (` (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$" - (if (, group) - "\\|^[ ]*\\[[+-]\\]" - "")))) +(defun wl-folder-unread-regex (group) + (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$" + (if group + "\\|^[ ]*\\[[+-]\\]" + ""))) -(defmacro wl-folder-buffer-group-p () - (` (get-text-property (point) 'wl-folder-is-group))) +(defun wl-folder-buffer-group-p () + (get-text-property (point) 'wl-folder-is-group)) (defun wl-folder-buffer-search-group (group) (let ((prev-point (point)) @@ -273,32 +273,31 @@ (defmacro wl-folder-get-entity-id (entity) `(get-text-property 0 'wl-folder-entity-id ,entity)) -(defmacro wl-folder-get-entity-from-buffer (&optional getid) - `(let ((id (get-text-property (point) - 'wl-folder-entity-id))) - (if ,getid - id - (wl-folder-get-folder-name-by-id id)))) +(defun wl-folder-get-entity-from-buffer (&optional getid) + (let ((id (get-text-property (point) + 'wl-folder-entity-id))) + (if getid + id + (wl-folder-get-folder-name-by-id id)))) (defmacro wl-folder-entity-exists-p (entity &optional hashtb) - (` (let ((sym (intern-soft (, entity) - (or (, hashtb) wl-folder-entity-hashtb)))) - (and sym (boundp sym))))) + `(let ((sym (intern-soft ,entity (or ,hashtb wl-folder-entity-hashtb)))) + (and sym (boundp sym)))) (defmacro wl-folder-clear-entity-info (entity &optional hashtb) - (` (elmo-clear-hash-val (, entity) (or (, hashtb) wl-folder-entity-hashtb)))) + `(elmo-clear-hash-val ,entity (or ,hashtb wl-folder-entity-hashtb))) (defmacro wl-folder-get-entity-info (entity &optional hashtb) - (` (elmo-get-hash-val (, entity) (or (, hashtb) wl-folder-entity-hashtb)))) + `(elmo-get-hash-val ,entity (or ,hashtb wl-folder-entity-hashtb))) (defmacro wl-folder-set-entity-info (entity value &optional hashtb) - (` (let* ((hashtb (or (, hashtb) wl-folder-entity-hashtb)) - (info (wl-folder-get-entity-info (, entity) hashtb))) - (elmo-set-hash-val (elmo-string (, entity)) - (if (< (length (, value)) 4) - (append (, value) (list (nth 3 info))) - (, value)) - hashtb)))) + `(let* ((hashtb (or ,hashtb wl-folder-entity-hashtb)) + (info (wl-folder-get-entity-info ,entity hashtb))) + (elmo-set-hash-val (elmo-string ,entity) + (if (< (length ,value) 4) + (append ,value (list (nth 3 info))) + ,value) + hashtb))) (defun wl-folder-persistent-p (folder) (or (and (wl-folder-search-entity-by-name folder wl-folder-entity @@ -321,14 +320,14 @@ (defmacro wl-folder-elmo-folder-cache-get (name &optional hashtb) "Returns a elmo folder structure associated with NAME from HASHTB. Default HASHTB is `wl-folder-elmo-folder-hashtb'." - (` (elmo-get-hash-val (, name) - (or (, hashtb) wl-folder-elmo-folder-hashtb)))) + `(elmo-get-hash-val ,name + (or ,hashtb wl-folder-elmo-folder-hashtb))) (defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb) "Get folder elmo folder structure on HASHTB for folder with NAME. Default HASHTB is `wl-folder-elmo-folder-hashtb'." - (` (elmo-set-hash-val (, name) (, folder) - (or (, hashtb) wl-folder-elmo-folder-hashtb)))) + `(elmo-set-hash-val ,name ,folder + (or ,hashtb wl-folder-elmo-folder-hashtb))) (defun wl-draft-get-folder () "A function to obtain `opened' draft elmo folder structure." @@ -336,22 +335,30 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (string= (elmo-folder-name-internal wl-draft-folder-internal) wl-draft-folder)) wl-draft-folder-internal - (setq wl-draft-folder-internal (elmo-make-folder wl-draft-folder)) + (setq wl-draft-folder-internal (wl-folder-make-elmo-folder + wl-draft-folder)) (wl-folder-confirm-existence wl-draft-folder-internal) (elmo-folder-open wl-draft-folder-internal 'load-msgdb) wl-draft-folder-internal)) -(defmacro wl-folder-get-elmo-folder (entity &optional no-cache) +(defun wl-folder-mime-charset (folder-name) + (or (wl-get-assoc-list-value wl-folder-mime-charset-alist folder-name) + wl-mime-charset)) + +(defun wl-folder-make-elmo-folder (folder-name) + (elmo-make-folder folder-name nil (wl-folder-mime-charset folder-name))) + +(defsubst wl-folder-get-elmo-folder (entity &optional no-cache) "Get elmo folder structure from ENTITY." - `(if ,no-cache - (elmo-make-folder (elmo-string ,entity)) - (if (string= (elmo-string ,entity) wl-draft-folder) - (wl-draft-get-folder) - (or (wl-folder-elmo-folder-cache-get ,entity) - (let* ((name (elmo-string ,entity)) - (folder (elmo-make-folder name))) - (wl-folder-elmo-folder-cache-put name folder) - folder))))) + (let ((name (elmo-string entity))) + (if no-cache + (wl-folder-make-elmo-folder name) + (if (string= name wl-draft-folder) + (wl-draft-get-folder) + (or (wl-folder-elmo-folder-cache-get name) + (let ((folder (wl-folder-make-elmo-folder name))) + (wl-folder-elmo-folder-cache-put name folder) + folder)))))) (defsubst wl-folder-put-folder-property (beg end id is-group &optional object) (put-text-property beg end 'wl-folder-entity-id id object) @@ -513,14 +520,12 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (defun wl-folder-set-persistent-mark (folder number flag) "Set a persistent mark which corresponds to the specified flag on message." - (let ((buffer (wl-summary-get-buffer folder)) - elmo-folder) + (let ((buffer (wl-summary-get-buffer folder))) (if buffer (with-current-buffer buffer (wl-summary-set-persistent-mark flag number)) ;; Parent buffer does not exist. - (when (setq elmo-folder (and folder - (wl-folder-get-elmo-folder folder))) + (let ((elmo-folder (wl-folder-get-elmo-folder folder))) (elmo-folder-open elmo-folder 'load-msgdb) (elmo-folder-set-flag elmo-folder (list wl-draft-parent-number) flag) (elmo-folder-close elmo-folder))))) @@ -859,19 +864,16 @@ Optional argument ARG is repeart count." (if (wl-string-match-member entity wl-strict-diff-folders) (elmo-strict-folder-diff folder) (elmo-folder-diff folder))) + (elmo-open-error + (signal (car err) (cdr err))) (error ;; maybe not exist folder. - (if (and (not (or (memq 'elmo-open-error - (get (car err) 'error-conditions)) - (memq 'elmo-imap4-bye-error - (get (car err) 'error-conditions)))) - (not (elmo-folder-exists-p folder))) + (if (not (elmo-folder-exists-p folder)) (wl-folder-create-subr folder) (signal (car err) (cdr err)))))) (new (elmo-diff-new nums)) (unread (elmo-diff-unread nums)) - (all (elmo-diff-all nums)) - unsync nomif) + (all (elmo-diff-all nums))) (if (and (eq wl-folder-notify-deleted 'sync) (or (and new (> 0 new)) (and unread (> 0 unread)) @@ -886,10 +888,11 @@ Optional argument ARG is repeart count." (setq new (and new (max 0 new)) unread (and unread (max 0 unread)) all (and all (max 0 all)))) - (setq unread (or (and unread (- unread (or new 0))) - (elmo-folder-get-info-unread folder) - (or (cdr (assq 'unread - (elmo-folder-count-flags folder))) 0))) + (setq unread (if unread + (- unread (or new 0)) + (or (elmo-folder-get-info-unread folder) + (cdr (assq 'unread (elmo-folder-count-flags folder))) + 0))) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity (list new unread all) (get-buffer wl-folder-buffer-name))) @@ -1037,36 +1040,32 @@ If current line is group folder, check all sub entries." ((stringp entity) (let* ((folder (wl-folder-get-elmo-folder entity)) (nums (wl-folder-get-entity-info entity)) - (wl-summary-highlight (if (or (wl-summary-sticky-p folder) - (wl-summary-always-sticky-folder-p - folder)) - wl-summary-highlight)) - wl-auto-select-first new unread sticky) - (setq new (or (car nums) 0)) - (setq unread (or (cadr nums) 0)) - (if (or (not unread-only) - (or (< 0 new) (< 0 unread))) - (let ((wl-summary-buffer-name - (if (setq sticky (get-buffer (wl-summary-sticky-buffer-name - (elmo-folder-name-internal - folder)))) - ;; Sticky folder exists. - (wl-summary-sticky-buffer-name - (elmo-folder-name-internal folder)) - (concat - wl-summary-buffer-name - (symbol-name this-command)))) - (wl-summary-use-frame nil) - (wl-summary-always-sticky-folder-list nil)) - (save-window-excursion - (save-excursion - (wl-summary-goto-folder-subr entity - (wl-summary-get-sync-range - folder) - nil nil nil t) - (if sticky - (wl-summary-save-status) - (wl-summary-exit)))))))))) + (new (or (car nums) 0)) + (unread (or (cadr nums) 0))) + (when (or (not unread-only) + (or (> new 0) (> unread 0))) + (let ((summary (wl-summary-get-buffer entity)) + (range (wl-summary-get-sync-range folder))) + (if summary + (save-selected-window + (with-current-buffer summary + (let ((win (get-buffer-window summary t))) + (when win + (select-window win))) + (wl-summary-sync 'unset-cursor range) + (wl-summary-save-status))) + (elmo-folder-open folder 'load-msgdb) + (unwind-protect + (progn + (elmo-folder-synchronize folder nil (eq range 'all)) + (wl-folder-set-folder-updated + entity + (list + 0 + (or (cdr (assq 'unread (elmo-folder-count-flags folder))) + 0) + (elmo-folder-length folder)))) + (elmo-folder-close folder))))))))) (defun wl-folder-sync-current-entity (&optional unread-only) "Synchronize the folder at position. @@ -1094,39 +1093,34 @@ If current line is group folder, check all subfolders." (wl-folder-mark-as-read-all-entity (car flist)) (setq flist (cdr flist))))) ((stringp entity) - (let* ((nums (wl-folder-get-entity-info entity)) - (folder (wl-folder-get-elmo-folder entity)) - (wl-summary-highlight (if (or (wl-summary-sticky-p folder) - (wl-summary-always-sticky-folder-p - folder)) - wl-summary-highlight)) - wl-auto-select-first new unread sticky) - (setq new (or (car nums) 0)) - (setq unread (or (cadr nums) 0)) - (if (or (< 0 new) (< 0 unread)) - (save-window-excursion - (save-excursion - (let ((wl-summary-buffer-name - (if (setq sticky (get-buffer - (wl-summary-sticky-buffer-name - (elmo-folder-name-internal - folder)))) - ;; Sticky folder exists. - (wl-summary-sticky-buffer-name - (elmo-folder-name-internal folder)) - (concat - wl-summary-buffer-name - (symbol-name this-command)))) - (wl-summary-use-frame nil) - (wl-summary-always-sticky-folder-list nil)) - (wl-summary-goto-folder-subr entity - (wl-summary-get-sync-range folder) - nil) - (wl-summary-mark-as-read-all) - (if sticky - (wl-summary-save-status) - (wl-summary-exit))))) - (sit-for 0)))))) + (let* ((folder (wl-folder-get-elmo-folder entity)) + (nums (wl-folder-get-entity-info entity)) + (new (or (car nums) 0)) + (unread (or (cadr nums) 0))) + (when (or (> new 0) (> unread 0)) + (let ((summary (wl-summary-get-buffer entity)) + (range (wl-summary-get-sync-range folder))) + (if summary + (save-selected-window + (with-current-buffer summary + (let ((win (get-buffer-window summary t))) + (when win + (select-window win))) + (wl-summary-sync 'unset-cursor range) + (wl-summary-mark-as-read-all) + (wl-summary-save-status))) + (elmo-folder-open folder 'load-msgdb) + (unwind-protect + (progn + (elmo-folder-synchronize folder nil (eq range 'all)) + (elmo-folder-unset-flag + folder + (elmo-folder-list-flagged folder 'unread 'in-msgdb) + 'unread) + (wl-folder-set-folder-updated + entity + (list 0 0 (elmo-folder-length folder)))) + (elmo-folder-close folder))))))))) (defun wl-folder-mark-as-read-all-current-entity () "Mark as read all messages in the folder at position. @@ -1409,8 +1403,9 @@ If current line is group folder, all subfolders are marked." ;; hide wl-summary window. (let ((cur-buf (current-buffer)) (summary-buffer (wl-summary-get-buffer folder))) - (wl-folder-select-buffer summary-buffer) - (delete-window) + (when summary-buffer + (wl-folder-select-buffer summary-buffer) + (delete-window)) (select-window (get-buffer-window cur-buf)))) (t (setq wl-folder-buffer-disp-summary @@ -1426,9 +1421,11 @@ If current line is group folder, all subfolders are marked." (unwind-protect (wl-summary-goto-folder-subr folder-name 'no-sync nil) (select-window (get-buffer-window cur-buf)))) - (wl-folder-select-buffer (wl-summary-get-buffer folder-name)) - (delete-window) - (select-window (get-buffer-window cur-buf))))))))) + (let ((summary-buffer (wl-summary-get-buffer folder-name))) + (when summary-buffer + (wl-folder-select-buffer summary-buffer) + (delete-window)) + (select-window (get-buffer-window cur-buf)))))))))) (defun wl-folder-prev-unsync () "Move cursor to the previous unsync folder." @@ -1626,12 +1623,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (list new unread all))) (defsubst wl-folder-make-save-access-list (list) - (mapcar '(lambda (x) - (cond - ((consp x) - (list (elmo-string (car x)) 'access)) - (t - (elmo-string x)))) + (mapcar (lambda (x) + (cond + ((consp x) + (list (elmo-string (car x)) 'access)) + (t + (elmo-string x)))) list)) (defun wl-folder-update-newest (indent entity) @@ -1765,9 +1762,9 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (wl-highlight-folder-current-line)) (setq removed (cdr removed))) (remove-text-properties beg (point) '(wl-folder-entity-id))) - (let* ((len (length flist)) - (mes (> len 100)) - (i 0)) + (elmo-with-progress-display + (wl-folder-insert-entity (length flist)) + (format "Inserting group %s" (car entity)) (while flist (setq ret-val (wl-folder-insert-entity @@ -1775,15 +1772,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (setq new (+ (or new 0) (or (nth 0 ret-val) 0))) (setq unread (+ (or unread 0) (or (nth 1 ret-val) 0))) (setq all (+ (or all 0) (or (nth 2 ret-val) 0))) - (when (and mes - (> len elmo-display-progress-threshold)) - (setq i (1+ i)) - (elmo-display-progress - 'wl-folder-insert-entity "Inserting group %s..." - (/ (* i 100) len) (car entity))) - (setq flist (cdr flist))) - (if (> len 0) - (message "Inserting group %s...done" (car entity)))) + (elmo-progress-notify 'wl-folder-insert-entity) + (setq flist (cdr flist)))) (save-excursion (goto-char group-name-end) (delete-region (point) (save-excursion (end-of-line) @@ -2063,7 +2053,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (when wl-smtp-posting-server (elmo-set-plugged wl-plugged wl-smtp-posting-server ; server - (or (and (boundp 'smtp-service) smtp-service) + (or wl-smtp-posting-port + (and (boundp 'smtp-service) smtp-service) "smtp") ; port wl-smtp-connection-type nil nil "smtp" add)) @@ -2071,8 +2062,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (when wl-nntp-posting-server (elmo-set-plugged wl-plugged wl-nntp-posting-server - wl-nntp-posting-stream-type wl-nntp-posting-port + wl-nntp-posting-stream-type nil nil "nntp" add)) (run-hooks 'wl-make-plugged-hook))) @@ -2207,11 +2198,11 @@ Use `wl-subscribed-mailing-list'." (setq is-group (get-text-property (point) 'wl-folder-is-group)) (when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)") ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)") - (setq cur-new (string-to-int + (setq cur-new (string-to-number (wl-match-buffer 2))) - (setq cur-unread (string-to-int + (setq cur-unread (string-to-number (wl-match-buffer 3))) - (setq cur-all (string-to-int + (setq cur-all (string-to-number (wl-match-buffer 4))) (delete-region (match-beginning 2) (match-end 4)) @@ -2552,37 +2543,30 @@ Use `wl-subscribed-mailing-list'." (erase-buffer) (wl-folder-insert-entity " " wl-folder-entity) (wl-folder-move-path id)) - (message "Opening all folders...") - (wl-folder-open-all-pre) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$" - nil t) - (setq indent (wl-match-buffer 1)) - (setq name (wl-folder-get-entity-from-buffer)) - (setq entity (wl-folder-search-group-entity-by-name - name - wl-folder-entity)) - ;; insert as opened - (setcdr (assoc (car entity) wl-folder-group-alist) t) - (beginning-of-line) - (wl-folder-insert-entity indent entity) - (delete-region (save-excursion (beginning-of-line) - (point)) - (save-excursion (end-of-line) - (+ 1 (point)))) - (when (> len elmo-display-progress-threshold) - (setq i (1+ i)) - (if (or (zerop (% i 5)) (= i len)) - (elmo-display-progress - 'wl-folder-open-all "Opening all folders..." - (/ (* i 100) len))))) - (when (> len elmo-display-progress-threshold) - (elmo-display-progress - 'wl-folder-open-all "Opening all folders..." 100)))) + (elmo-with-progress-display + (wl-folder-open-all (length wl-folder-group-alist)) + "Opening all folders" + (wl-folder-open-all-pre) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$" + nil t) + (setq indent (wl-match-buffer 1)) + (setq name (wl-folder-get-entity-from-buffer)) + (setq entity (wl-folder-search-group-entity-by-name + name + wl-folder-entity)) + ;; insert as opened + (setcdr (assoc (car entity) wl-folder-group-alist) t) + (beginning-of-line) + (wl-folder-insert-entity indent entity) + (delete-region (save-excursion (beginning-of-line) + (point)) + (save-excursion (end-of-line) + (+ 1 (point)))) + (elmo-progress-notify 'wl-folder-open-all))))) (wl-highlight-folder-path wl-folder-buffer-cur-path) - (message "Opening all folders...done") (set-buffer-modified-p nil))) (defun wl-folder-close-all () @@ -2636,101 +2620,91 @@ Use `wl-subscribed-mailing-list'." t))) (defun wl-folder-update-access-group (entity new-flist) - (let* ((flist (nth 2 entity)) - (unsubscribes (nth 3 entity)) - (len (+ (length flist) (length unsubscribes))) - (i 0) - diff new-unsubscribes removes - subscribed-list folder group entry) - ;; check subscribed groups - (while flist - (cond - ((listp (car flist)) ;; group - (setq group (elmo-string (caar flist))) + (let ((flist (nth 2 entity)) + (unsubscribes (nth 3 entity)) + diff new-unsubscribes removes + subscribed-list folder group entry) + (elmo-with-progress-display + (wl-folder-update-access-group (+ (length flist) (length unsubscribes))) + "Updating access group" + ;; check subscribed groups + (while flist (cond - ((assoc group new-flist) ;; found in new-flist - (setq new-flist (delete (assoc group new-flist) - new-flist)) - (if (wl-folder-access-subscribe-p (car entity) group) - (wl-append subscribed-list (list (car flist))) - (wl-append new-unsubscribes (list (car flist))) - (setq diff t))) - (t - (setq wl-folder-group-alist - (delete (wl-string-assoc group wl-folder-group-alist) - wl-folder-group-alist)) - (wl-append removes (list (list group)))))) - (t ;; folder - (setq folder (elmo-string (car flist))) + ((listp (car flist)) ;; group + (setq group (elmo-string (caar flist))) + (cond + ((assoc group new-flist) ;; found in new-flist + (setq new-flist (delete (assoc group new-flist) + new-flist)) + (if (wl-folder-access-subscribe-p (car entity) group) + (wl-append subscribed-list (list (car flist))) + (wl-append new-unsubscribes (list (car flist))) + (setq diff t))) + (t + (setq wl-folder-group-alist + (delete (wl-string-assoc group wl-folder-group-alist) + wl-folder-group-alist)) + (wl-append removes (list (list group)))))) + (t ;; folder + (setq folder (elmo-string (car flist))) + (cond + ((member folder new-flist) ;; found in new-flist + (setq new-flist (delete folder new-flist)) + (if (wl-folder-access-subscribe-p (car entity) folder) + (wl-append subscribed-list (list (car flist))) + (wl-append new-unsubscribes (list folder)) + (setq diff t))) + (t + (wl-append removes (list folder)))))) + (elmo-progress-notify 'wl-folder-update-access-group) + (setq flist (cdr flist))) + ;; check unsubscribed groups + (while unsubscribes (cond - ((member folder new-flist) ;; found in new-flist - (setq new-flist (delete folder new-flist)) - (if (wl-folder-access-subscribe-p (car entity) folder) - (wl-append subscribed-list (list (car flist))) - (wl-append new-unsubscribes (list folder)) - (setq diff t))) + ((listp (car unsubscribes)) + (when (setq entry (assoc (caar unsubscribes) new-flist)) + (setq new-flist (delete entry new-flist)) + (wl-append new-unsubscribes (list (car unsubscribes))))) (t - (wl-append removes (list folder)))))) - (when (> len elmo-display-progress-threshold) - (setq i (1+ i)) - (if (or (zerop (% i 10)) (= i len)) - (elmo-display-progress - 'wl-folder-update-access-group "Updating access group..." - (/ (* i 100) len)))) - (setq flist (cdr flist))) - ;; check unsubscribed groups - (while unsubscribes - (cond - ((listp (car unsubscribes)) - (when (setq entry (assoc (caar unsubscribes) new-flist)) - (setq new-flist (delete entry new-flist)) - (wl-append new-unsubscribes (list (car unsubscribes))))) - (t - (when (member (car unsubscribes) new-flist) - (setq new-flist (delete (car unsubscribes) new-flist)) - (wl-append new-unsubscribes (list (car unsubscribes)))))) - (when (> len elmo-display-progress-threshold) - (setq i (1+ i)) - (if (or (zerop (% i 10)) (= i len)) - (elmo-display-progress - 'wl-folder-update-access-group "Updating access group..." - (/ (* i 100) len)))) - (setq unsubscribes (cdr unsubscribes))) - ;; - (if (or new-flist removes) - (setq diff t)) - (setq new-flist - (mapcar '(lambda (x) - (cond ((consp x) (list (car x) 'access)) - (t x))) - new-flist)) - ;; check new groups - (let ((new-list new-flist)) - (while new-list - (if (not (wl-folder-access-subscribe-p - (car entity) - (if (listp (car new-list)) - (caar new-list) - (car new-list)))) - ;; auto unsubscribe - (progn - (wl-append new-unsubscribes (list (car new-list))) - (setq new-flist (delete (car new-list) new-flist))) - (cond - ((listp (car new-list)) - ;; check group exists - (if (wl-string-assoc (caar new-list) wl-folder-group-alist) - (progn - (message "%s: group already exists." (caar new-list)) - (sit-for 1) - (wl-append new-unsubscribes (list (car new-list))) - (setq new-flist (delete (car new-list) new-flist))) - (wl-append wl-folder-group-alist - (list (cons (caar new-list) nil))))))) - (setq new-list (cdr new-list)))) - (if new-flist - (message "%d new folder(s)." (length new-flist)) - (message "Updating access group...done")) + (when (member (car unsubscribes) new-flist) + (setq new-flist (delete (car unsubscribes) new-flist)) + (wl-append new-unsubscribes (list (car unsubscribes)))))) + (elmo-progress-notify 'wl-folder-update-access-group) + (setq unsubscribes (cdr unsubscribes))) + ;; + (if (or new-flist removes) + (setq diff t)) + (setq new-flist + (mapcar (lambda (x) + (cond ((consp x) (list (car x) 'access)) + (t x))) + new-flist)) + ;; check new groups + (let ((new-list new-flist)) + (while new-list + (if (not (wl-folder-access-subscribe-p + (car entity) + (if (listp (car new-list)) + (caar new-list) + (car new-list)))) + ;; auto unsubscribe + (progn + (wl-append new-unsubscribes (list (car new-list))) + (setq new-flist (delete (car new-list) new-flist))) + (cond + ((listp (car new-list)) + ;; check group exists + (if (wl-string-assoc (caar new-list) wl-folder-group-alist) + (progn + (message "%s: group already exists." (caar new-list)) + (sit-for 1) + (wl-append new-unsubscribes (list (car new-list))) + (setq new-flist (delete (car new-list) new-flist))) + (wl-append wl-folder-group-alist + (list (cons (caar new-list) nil))))))) + (setq new-list (cdr new-list))))) + (when new-flist + (message "%d new folder(s)." (length new-flist))) (wl-append new-flist subscribed-list) ;; new is first (run-hooks 'wl-folder-update-access-group-hook) (setcdr (cdr entity) (list new-flist new-unsubscribes)) @@ -2886,19 +2860,16 @@ Call `wl-summary-write-current-folder' with current folder name." (kill-buffer bufname)))) (defun wl-folder-create-subr (folder) - (if (elmo-folder-creatable-p folder) - (if (y-or-n-p (format "Folder %s does not exist, create it? " - (elmo-folder-name-internal folder))) - (progn - (message "") - (setq wl-folder-entity-hashtb - (wl-folder-create-entity-hashtb - (elmo-folder-name-internal folder) - wl-folder-entity-hashtb)) - (unless (elmo-folder-create folder) - (error "Create folder failed"))) - (error "Folder %s is not created" (elmo-folder-name-internal folder))) - (error "Folder %s does not exist" (elmo-folder-name-internal folder)))) + (let ((name (elmo-folder-name-internal folder))) + (unless (elmo-folder-creatable-p folder) + (error "Folder %s does not exist" name)) + (unless (y-or-n-p (format "Folder %s does not exist, create it? " name)) + (error "Folder %s is not created" name)) + (message "") + (setq wl-folder-entity-hashtb + (wl-folder-create-entity-hashtb name wl-folder-entity-hashtb)) + (unless (elmo-folder-create folder) + (error "Create folder failed")))) (defun wl-folder-confirm-existence (folder &optional force) (if force @@ -2956,10 +2927,10 @@ Call `wl-summary-write-current-folder' with current folder name." (setq folder-list (cdr folder-list))) (if results (message "%s are picked." - (mapconcat '(lambda (res) - (format "%s(%d)" - (car res) - (length (cdr res)))) + (mapconcat (lambda (res) + (format "%s(%d)" + (car res) + (length (cdr res)))) results ",")) (message "No message was picked."))))) @@ -3021,7 +2992,7 @@ Call `wl-summary-write-current-folder' with current folder name." (defun wl-folder-complete-filter-condition (string predicate flag) (cond - ((string-match "^\\(.*|\\|.*&\\|.*!\\|.*(\\)\\([^:]*\\)$" string) + ((string-match "^\\(.*|\\|.*&\\|.*(\\)\\([^:]*\\)$" string) (let* ((str1 (match-string 1 string)) (str2 (match-string 2 string)) (str2-comp @@ -3036,10 +3007,7 @@ Call `wl-summary-write-current-folder' with current folder name." (t (let ((candidate (mapcar (lambda (x) (list (concat (downcase x) ":"))) - (append '("last" "first" - "from" "subject" "to" "cc" "body" - "since" "before" "tocc") - elmo-msgdb-extra-fields)))) + (wl-search-condition-fields)))) (if (not flag) (try-completion string candidate) (all-completions string candidate))))))