X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=ded521839a2d3d284433139acd35f0e5d0c229b2;hb=abd7d9a4229a516f87cf46345ed6e5bb34ae41df;hp=4099f3ba42dbec51f3f99ff069c79bafbea6bfbc;hpb=2a411790da5e15af74e1b82857c221cea02059f7;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 4099f3b..ded5218 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -61,7 +61,6 @@ (defvar wl-folder-newsgroups-hashtb nil) (defvar wl-folder-info-alist-modified nil) -(defvar wl-folder-completion-function nil) (defvar wl-folder-mode-map nil) @@ -116,6 +115,8 @@ ["Write a message" wl-draft t] ["Write for current folder" wl-folder-write-current-folder t] "----" + ["Wanderlust NEWS" wl-news t] + "----" ["Toggle Plug Status" wl-toggle-plugged t] ["Change Plug Status" wl-plugged-change t] "----" @@ -226,27 +227,20 @@ "")))) (defmacro wl-folder-buffer-group-p () - (` (save-excursion (beginning-of-line) - (looking-at wl-folder-group-regexp)))) - -(defmacro wl-folder-folder-name () - (` (save-excursion - (beginning-of-line) - (if (or (looking-at "^[ ]*\\[[\\+-]\\]\\(.+\\):[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+\n") - (looking-at "^[ ]*\\([^\\[].+\\):.*\n")) - (wl-match-buffer 1))))) - -(defmacro wl-folder-entity-name () - (` (save-excursion - (beginning-of-line) - (if (looking-at "^[ ]*\\([^\\[].+\\):.*\n") - (wl-match-buffer 1))))) + (` (get-text-property (point) 'wl-folder-is-group))) (defun wl-folder-buffer-search-group (group) - (re-search-forward - (concat - "^\\([ \t]*\\)\\[[\\+-]\\]" - (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t)) + (let ((prev-point (point)) + (group-regexp (concat + "^\\([ \t]*\\)\\[[\\+-]\\]" + (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+"))) + (or (catch 'found + (while (re-search-forward group-regexp nil t) + (if (wl-folder-buffer-group-p) + (throw 'found (point))))) + (progn ; not found + (goto-char prev-point) + nil)))) (defun wl-folder-buffer-search-entity (folder &optional searchname) (let ((search (or searchname (wl-folder-get-petname folder))) @@ -329,16 +323,33 @@ Default HASHTB is `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." + (if (and wl-draft-folder-internal + (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)) + (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) - "Get elmo folder structure from entity." - (` (if (, no-cache) - (elmo-make-folder (elmo-string (, entity))) - (or (wl-folder-elmo-folder-cache-get (, entity)) - (let* ((name (elmo-string (, entity))) + "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))))) +(defsubst wl-folder-put-folder-property (beg end id is-group &optional object) + (put-text-property beg end 'wl-folder-entity-id id object) + (put-text-property beg end 'wl-folder-is-group is-group object)) + (defun wl-folder-prev-entity () (interactive) (forward-line -1)) @@ -348,7 +359,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (forward-line 1)) (defun wl-folder-prev-entity-skip-invalid (&optional hereto) - "move to previous entity. skip unsubscribed or removed entity." + "Move to previous entity. skip unsubscribed or removed entity." (interactive) (if hereto (end-of-line)) @@ -499,11 +510,11 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (let ((cur-buf (current-buffer)) (wl-auto-select-first nil) trash-buf emptied) + (wl-summary-goto-folder-subr wl-trash-folder 'force-update) + (setq trash-buf (wl-summary-get-buffer-create wl-trash-folder)) (if wl-stay-folder-window - (wl-folder-select-buffer - (wl-summary-get-buffer-create wl-trash-folder))) - (wl-summary-goto-folder-subr wl-trash-folder 'force-update nil nil t) - (setq trash-buf (current-buffer)) + (wl-folder-select-buffer trash-buf) + (switch-to-buffer trash-buf)) (unwind-protect (setq emptied (wl-summary-delete-all-msgs)) (when emptied @@ -605,9 +616,10 @@ Optional argument ARG is repeart count." (beginning-of-line) (let (entity beg end indent opened fname err fld-name) (cond - ((looking-at wl-folder-group-regexp) + ((and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) (save-excursion - (setq fname (wl-folder-get-realname (wl-match-buffer 3))) + (setq fname (wl-folder-get-entity-from-buffer)) (setq indent (wl-match-buffer 1)) (setq opened (wl-match-buffer 2)) (if (string= opened "+") @@ -664,7 +676,7 @@ Optional argument ARG is repeart count." ; (wl-delete-all-overlays) ; (wl-highlight-folder-current-line) ))) - ((setq fld-name (wl-folder-entity-name)) + ((setq fld-name (wl-folder-get-entity-from-buffer)) (wl-folder-set-current-entity-id (get-text-property (point) 'wl-folder-entity-id)) (setq fld-name (wl-folder-get-folder-name-by-id @@ -698,14 +710,16 @@ Optional argument ARG is repeart count." (defun wl-folder-update-recursive-current-entity (&optional entity) (interactive) - (when (wl-folder-buffer-group-p) + (beginning-of-line) + (when (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) (cond ((string= (wl-match-buffer 2) "+") (save-excursion (if entity () (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))) (let ((inhibit-read-only t) (entities (list entity)) @@ -809,27 +823,28 @@ Optional argument ARG is repeart count." (t (message "Uncheck(unplugged) \"%s\"" entity))))) (if ret-val - (message "Checking \"%s\" is done." + (message "Checking \"%s\" is done" (if (consp entity) (car entity) entity))) (run-hooks 'wl-folder-check-entity-hook) ret-val)) (defun wl-folder-check-one-entity (entity &optional biff) (let* ((folder (wl-folder-get-elmo-folder entity biff)) - (nums ;(condition-case err + (nums (condition-case err (progn (if biff (elmo-folder-set-biff-internal folder t)) (if (wl-string-match-member entity wl-strict-diff-folders) (elmo-strict-folder-diff folder) (elmo-folder-diff folder))) - ; (error + (error ;; maybe not exist folder. - ; (if (and (not (memq 'elmo-open-error - ; (get (car err) 'error-conditions))) - ; (not (elmo-folder-exists-p folder))) - ; (wl-folder-create-subr folder) - ; (signal (car err) (cdr err)))))) - ) + (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))) + (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)) @@ -850,7 +865,7 @@ Optional argument ARG is repeart count." all (and all (max 0 all)))) (setq unread (or (and unread (- unread (or new 0))) (elmo-folder-get-info-unread folder) - (cdr (wl-summary-count-unread)))) + (nth 1 (elmo-folder-count-flags folder)))) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity (list new unread all) (get-buffer wl-folder-buffer-name))) @@ -953,21 +968,21 @@ Optional argument ARG is repeart count." (goto-char wl-folder-buffer-cur-point)))) (defun wl-folder-set-current-entity-id (entity-id) - (let ((buf (get-buffer wl-folder-buffer-name))) + (let* ((buf (get-buffer wl-folder-buffer-name)) + (buf-win (get-buffer-window buf))) (if buf - (save-excursion - (set-buffer buf) - (setq wl-folder-buffer-cur-entity-id entity-id) - (setq wl-folder-buffer-cur-path (wl-folder-get-path wl-folder-entity - entity-id)) - (wl-highlight-folder-path wl-folder-buffer-cur-path) - (and wl-folder-move-cur-folder - wl-folder-buffer-cur-point - (goto-char wl-folder-buffer-cur-point)))) - (if (eq (current-buffer) buf) - (and wl-folder-move-cur-folder - wl-folder-buffer-cur-point - (goto-char wl-folder-buffer-cur-point))))) + (save-current-buffer + (save-selected-window + (if buf-win + (select-window buf-win) + (set-buffer buf)) + (setq wl-folder-buffer-cur-entity-id entity-id) + (setq wl-folder-buffer-cur-path + (wl-folder-get-path wl-folder-entity entity-id)) + (wl-highlight-folder-path wl-folder-buffer-cur-path) + (and wl-folder-move-cur-folder + wl-folder-buffer-cur-point + (goto-char wl-folder-buffer-cur-point))))))) (defun wl-folder-check-current-entity () "Check folder at position. @@ -1095,7 +1110,8 @@ If current line is group folder, all subfolders are marked." (group (wl-folder-buffer-group-p)) summary-buf) (when (and entity-name - (y-or-n-p (format "Mark all messages in %s as read? " entity-name))) + (y-or-n-p (format "Mark all messages in %s as read? " + entity-name))) (wl-folder-mark-as-read-all-entity (if group (wl-folder-search-group-entity-by-name entity-name @@ -1298,10 +1314,11 @@ If current line is group folder, all subfolders are marked." (get-text-property 0 'wl-folder-entity-id (car entity)))) - (put-text-property 0 (length (car entity)) - 'wl-folder-entity-id - wl-folder-entity-id - (car entity)) + (wl-folder-put-folder-property + 0 (length (car entity)) + wl-folder-entity-id + 'is-group + (car entity)) (wl-folder-set-id-name wl-folder-entity-id (car entity) hashtb)) (and entities @@ -1312,10 +1329,11 @@ If current line is group folder, all subfolders are marked." (get-text-property 0 'wl-folder-entity-id entity))) - (put-text-property 0 (length entity) - 'wl-folder-entity-id - wl-folder-entity-id - entity) + (wl-folder-put-folder-property + 0 (length entity) + wl-folder-entity-id + nil + entity) (wl-folder-set-id-name wl-folder-entity-id entity hashtb)))) (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)) @@ -1406,8 +1424,7 @@ If current line is group folder, all subfolders are marked." (if (or (wl-folder-buffer-group-p) (not plugged) (setq entity - (wl-folder-get-realname - (wl-folder-folder-name))) + (wl-folder-get-entity-from-buffer)) (elmo-folder-plugged-p entity)) (throw 'found t)))) (beginning-of-line) @@ -1423,7 +1440,7 @@ If current line is group folder, all subfolders are marked." (if (re-search-backward (wl-folder-unread-regex group) nil t) (progn (beginning-of-line) - (wl-folder-folder-name)) + (wl-folder-get-entity-from-buffer)) (goto-char start-point) (message "No more unread folder") nil))) @@ -1437,7 +1454,7 @@ If current line is group folder, all subfolders are marked." (if (re-search-forward (wl-folder-unread-regex group) nil t) (progn (beginning-of-line) - (wl-folder-folder-name)) + (wl-folder-get-entity-from-buffer)) (goto-char start-point) (message "No more unread folder") nil))) @@ -1700,12 +1717,15 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." ;;; wl-folder-newsgroups-hashtb)))) ;;; (message "fetching folder entries...done")) (insert indent "[" (if as-opened "-" "+") "]" - (wl-folder-get-petname (car entity))) + (if (eq (cadr entity) 'access) + (wl-folder-get-petname (car entity)) + (car entity))) (setq group-name-end (point)) (insert ":0/0/0\n") - (put-text-property beg (point) 'wl-folder-entity-id - (get-text-property 0 'wl-folder-entity-id - (car entity))) + (wl-folder-put-folder-property + beg (point) + (get-text-property 0 'wl-folder-entity-id (car entity)) + 'is-group) (when removed (setq beg (point)) (while removed @@ -1735,7 +1755,9 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (elmo-display-progress 'wl-folder-insert-entity "Inserting group %s..." (/ (* i 100) len) (car entity))) - (setq flist (cdr flist)))) + (setq flist (cdr flist))) + (if (> len 0) + (message "Inserting group %s...done" (car entity)))) (save-excursion (goto-char group-name-end) (delete-region (point) (save-excursion (end-of-line) @@ -1746,15 +1768,18 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (wl-highlight-folder-current-line ret-val))) (setq ret-val (wl-folder-calc-finfo entity)) (insert indent "[" (if as-opened "-" "+") "]" - (wl-folder-get-petname (car entity)) + (if (eq (cadr entity) 'access) + (wl-folder-get-petname (car entity)) + (car entity)) (format ":%d/%d/%d" (or (nth 0 ret-val) 0) (or (nth 1 ret-val) 0) (or (nth 2 ret-val) 0)) "\n") - (put-text-property beg (point) 'wl-folder-entity-id - (get-text-property 0 'wl-folder-entity-id - (car entity))) + (wl-folder-put-folder-property + beg (point) + (get-text-property 0 'wl-folder-entity-id (car entity)) + 'is-group) (save-excursion (forward-line -1) (wl-highlight-folder-current-line ret-val))))) ((stringp entity) @@ -1770,8 +1795,10 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (+ (nth 0 nums)(nth 1 nums)))) "*") (or (setq all (nth 2 nums)) "*"))) - (put-text-property beg (point) 'wl-folder-entity-id - (get-text-property 0 'wl-folder-entity-id entity)) + (wl-folder-put-folder-property + beg (point) + (get-text-property 0 'wl-folder-entity-id entity) + nil) (save-excursion (forward-line -1) (wl-highlight-folder-current-line nums)) (setq ret-val (list new unread all))))) @@ -1783,13 +1810,11 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (wl-folder-check-entity wl-folder-entity)) (defun wl-folder-entity-hashtb-set (entity-hashtb name value buffer) - (let (cur-val + (let ((cur-val (wl-folder-get-entity-info name entity-hashtb)) (new-diff 0) (unread-diff 0) (all-diff 0) - diffs - entity-list) - (setq cur-val (wl-folder-get-entity-info name entity-hashtb)) + diffs) (setq new-diff (- (or (nth 0 value) 0) (or (nth 0 cur-val) 0))) (setq unread-diff (+ new-diff @@ -1802,47 +1827,45 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (save-match-data (with-current-buffer buffer (save-excursion - (setq entity-list (wl-folder-search-entity-list-by-name - name wl-folder-entity)) - (while entity-list - (wl-folder-update-group (car entity-list) diffs) - (setq entity-list (cdr entity-list))) + (let ((entity-list (wl-folder-search-entity-list-by-name + name wl-folder-entity))) + (while entity-list + (wl-folder-update-group (car entity-list) diffs) + (setq entity-list (cdr entity-list)))) (goto-char (point-min)) (while (wl-folder-buffer-search-entity name) (wl-folder-update-line value)))))))) (defun wl-folder-update-unread (folder unread) -; (save-window-excursion - (let ((buf (get-buffer wl-folder-buffer-name)) - cur-unread - (unread-diff 0) - ;;(fld (elmo-string folder)) - value newvalue entity-list) + (let ((buf (get-buffer wl-folder-buffer-name)) + (value (wl-folder-get-entity-info folder)) + cur-unread + (unread-diff 0) + newvalue) ;;; Update folder-info ;;; (elmo-folder-set-info-hashtb fld nil nil nil unread) - (setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0)) - (setq unread-diff (- (or unread 0) cur-unread)) - (setq value (wl-folder-get-entity-info folder)) - (setq newvalue (list (nth 0 value) - unread - (nth 2 value))) - (wl-folder-set-entity-info folder newvalue) - (setq wl-folder-info-alist-modified t) - (when (and buf - (not (eq unread-diff 0))) - (save-match-data - (with-current-buffer buf - (save-excursion - (setq entity-list (wl-folder-search-entity-list-by-name - folder wl-folder-entity)) + (setq cur-unread (or (nth 1 value) 0)) + (setq unread-diff (- (or unread 0) cur-unread)) + (setq newvalue (list (nth 0 value) + unread + (nth 2 value))) + (wl-folder-set-entity-info folder newvalue) + (setq wl-folder-info-alist-modified t) + (when (and buf + (not (eq unread-diff 0))) + (save-match-data + (with-current-buffer buf + (save-excursion + (let ((entity-list (wl-folder-search-entity-list-by-name + folder wl-folder-entity))) (while entity-list (wl-folder-update-group (car entity-list) (list 0 unread-diff 0)) - (setq entity-list (cdr entity-list))) - (goto-char (point-min)) - (while (wl-folder-buffer-search-entity folder) - (wl-folder-update-line newvalue))))))));) + (setq entity-list (cdr entity-list)))) + (goto-char (point-min)) + (while (wl-folder-buffer-search-entity folder) + (wl-folder-update-line newvalue)))))))) (defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst) (let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id))) @@ -2075,7 +2098,7 @@ If FOLDER is multi, return comma separated string (cross post)." nil))) (defun wl-folder-guess-mailing-list-by-refile-rule (entity) - "Return ML address guess by FOLDER. + "Return ML address guess by ENTITY. Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'." (let ((flist (elmo-folder-get-primitive-list @@ -2113,7 +2136,7 @@ Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'." (elmo-string-matched-member tokey wl-subscribed-mailing-list t))))) (defun wl-folder-guess-mailing-list-by-folder-name (entity) - "Return ML address guess by FOLDER name's last hierarchy. + "Return ML address guess by ENTITY name's last hierarchy. Use `wl-subscribed-mailing-list'." (let ((flist (elmo-folder-get-primitive-list @@ -2151,10 +2174,11 @@ Use `wl-subscribed-mailing-list'." cur-new new-new cur-unread new-unread cur-all new-all - id) + id is-group) (save-excursion (beginning-of-line) (setq id (get-text-property (point) 'wl-folder-entity-id)) + (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 @@ -2170,8 +2194,7 @@ Use `wl-subscribed-mailing-list'." (setq new-new (+ cur-new (nth 0 diffs))) (setq new-unread (+ cur-unread (nth 1 diffs))) (setq new-all (+ cur-all (nth 2 diffs))))) - (put-text-property (match-beginning 2) (point) - 'wl-folder-entity-id id) + (wl-folder-put-folder-property (match-beginning 2) (point) id is-group) (if wl-use-highlight-mouse-line (put-text-property (match-beginning 2) (point) 'mouse-face 'highlight)) @@ -2182,10 +2205,11 @@ Use `wl-subscribed-mailing-list'." (defun wl-folder-update-line (nums &optional is-group) (let ((inhibit-read-only t) (buffer-read-only nil) - id) + id is-group) (save-excursion (beginning-of-line) (setq id (get-text-property (point) 'wl-folder-entity-id)) + (setq is-group (get-text-property (point) 'wl-folder-is-group)) (if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)") ;;; (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)") (progn @@ -2198,8 +2222,7 @@ Use `wl-subscribed-mailing-list'." (+ (nth 0 nums)(nth 1 nums))) "*") (or (nth 2 nums) "*"))) - (put-text-property (match-beginning 2) (point) - 'wl-folder-entity-id id) + (wl-folder-put-folder-property (match-beginning 2) (point) id is-group) (if is-group ;; update only colors (wl-highlight-folder-group-line nums) @@ -2434,11 +2457,12 @@ Use `wl-subscribed-mailing-list'." (car path)))))) (beginning-of-line) (setq path (cdr path)) - (if (and (looking-at wl-folder-group-regexp) + (if (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp) (string= "+" (wl-match-buffer 2)));; closed group (save-excursion (setq indent (wl-match-buffer 1)) - (setq name (wl-folder-get-realname (wl-match-buffer 3))) + (setq name (wl-folder-get-entity-from-buffer)) (setq entity (wl-folder-search-group-entity-by-name name wl-folder-entity)) @@ -2494,16 +2518,16 @@ Use `wl-subscribed-mailing-list'." (save-excursion (goto-char (point-min)) (while (re-search-forward - "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n" + "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$" nil t) (setq indent (wl-match-buffer 1)) - (setq name (wl-folder-get-realname (wl-match-buffer 3))) + (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) - (forward-line -1) + (beginning-of-line) (wl-folder-insert-entity indent entity) (delete-region (save-excursion (beginning-of-line) (point)) @@ -2712,7 +2736,7 @@ Use `wl-subscribed-mailing-list'." folder)))) ;; Sticky folder exists. (wl-summary-sticky-buffer-name - (elmo-folder-name-internal folder)) + (elmo-folder-name-internal folder)) (concat wl-summary-buffer-name (symbol-name this-command)))) @@ -2730,14 +2754,11 @@ Use `wl-subscribed-mailing-list'." (cons 0 0)))))) (defun wl-folder-count-incorporates (folder) - (let ((marks (elmo-msgdb-mark-load - (elmo-folder-msgdb-path folder))) - (sum 0)) - (while marks - (if (member (cadr (car marks)) - wl-summary-incorporate-marks) - (incf sum)) - (setq marks (cdr marks))) + (let ((sum 0)) + (dolist (number (elmo-folder-list-flagged folder 'any)) + (when (member (wl-summary-message-mark folder number) + wl-summary-incorporate-marks) + (incf sum))) sum)) (defun wl-folder-prefetch-current-entity (&optional no-check) @@ -2810,7 +2831,7 @@ Call `wl-summary-write-current-folder' with current folder name." (interactive) (unless (wl-folder-buffer-group-p) (wl-summary-write-current-folder - (wl-folder-get-realname (wl-folder-entity-name))))) + (wl-folder-get-entity-from-buffer)))) (defun wl-folder-mimic-kill-buffer () "Kill the current (Folder) buffer with query." @@ -2826,16 +2847,16 @@ Call `wl-summary-write-current-folder' with current folder name." (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"))) + (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)))) @@ -2844,7 +2865,8 @@ Call `wl-summary-write-current-folder' with current folder name." (unless (elmo-folder-exists-p folder) (wl-folder-create-subr folder)) (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder)) - (file-exists-p (elmo-folder-msgdb-path folder)) + (and (elmo-folder-msgdb-path folder) + (file-exists-p (elmo-folder-msgdb-path folder))) (elmo-folder-exists-p folder)) (wl-folder-create-subr folder)))) @@ -2916,6 +2938,72 @@ Call `wl-summary-write-current-folder' with current folder name." (switch-to-buffer-other-window (car (wl-collect-summary)))) (wl-summary-previous-buffer))) +;;; +;; Completion +(defvar wl-folder-complete-folder-candidate nil) + +(defun wl-folder-complete-folder (string predicate flag) + (cond ((or (string-match "^\\(/[^/]*/\\)\\(.*\\)$" string) ; filter + (string-match "^\\(\*\\|\*.*,\\)\\([^,]*\\)$" string) ; multi + (string-match "^\\(|[^|]*|:?\\)\\(.*\\)$" string) ;pipe-src + (string-match "^\\(|\\)\\([^|]*\\)$" string)) ;pipe-dst + (let* ((str1 (match-string 1 string)) + (str2 (match-string 2 string)) + (str2-comp (wl-folder-complete-folder str2 predicate flag))) + (cond + ((listp str2-comp) ; flag=t + (mapcar (lambda (x) (concat str1 x)) str2-comp)) + ((stringp str2-comp) + (concat str1 str2-comp)) + (t + str2-comp)))) + ((string-match "^\\(/\\)\\([^/]*\\)$" string) ; filter-condition + (let* ((str1 (match-string 1 string)) + (str2 (match-string 2 string)) + (str2-comp + (wl-folder-complete-filter-condition str2 predicate flag))) + (cond + ((listp str2-comp) ; flag=t + (mapcar (lambda (x) (concat str1 x)) str2-comp)) + ((stringp str2-comp) + (concat str1 str2-comp)) + (t + str2-comp)))) + (t + (let ((candidate + (or wl-folder-complete-folder-candidate + (if (memq 'read-folder wl-use-folder-petname) + (wl-folder-get-entity-with-petname) + wl-folder-entity-hashtb)))) + (if (not flag) + (try-completion string candidate) + (all-completions string candidate)))))) + +(defun wl-folder-complete-filter-condition (string predicate flag) + (cond + ((string-match "^\\(.*|\\|.*&\\|.*!\\|.*(\\)\\([^:]*\\)$" string) + (let* ((str1 (match-string 1 string)) + (str2 (match-string 2 string)) + (str2-comp + (wl-folder-complete-filter-condition str2 predicate flag))) + (cond + ((listp str2-comp) ; flag=t + (mapcar (lambda (x) (concat str1 x)) str2-comp)) + ((stringp str2-comp) + (concat str1 str2-comp)) + (t + str2-comp)))) + (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)))) + (if (not flag) + (try-completion string candidate) + (all-completions string candidate)))))) + (require 'product) (product-provide (provide 'wl-folder) (require 'wl-version))