X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=f0db0ba9096225bd76be24461ba2d927b77e446a;hb=40ada79e654909e3b4061f1b7c59c447d00dd1d9;hp=30d5dd25c56e21769782254655c1be7f9aacf7ad;hpb=b28c84804f69ca7bcef44f009148bc8c92fd3467;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 30d5dd2..f0db0ba 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -66,11 +66,13 @@ (defvar wl-folder-buffer-disp-summary nil) (defvar wl-folder-buffer-cur-entity-id nil) +(defvar wl-folder-buffer-last-visited-entity-id nil) (defvar wl-folder-buffer-cur-path nil) (defvar wl-folder-buffer-cur-point nil) (make-variable-buffer-local 'wl-folder-buffer-disp-summary) (make-variable-buffer-local 'wl-folder-buffer-cur-entity-id) +(make-variable-buffer-local 'wl-folder-buffer-last-visited-entity-id) (make-variable-buffer-local 'wl-folder-buffer-cur-path) (make-variable-buffer-local 'wl-folder-buffer-cur-point) @@ -155,6 +157,7 @@ (define-key wl-folder-mode-map "g" 'wl-folder-goto-folder) (define-key wl-folder-mode-map "G" 'wl-folder-goto-folder-sticky) (define-key wl-folder-mode-map "j" 'wl-folder-jump-to-current-entity) + (define-key wl-folder-mode-map "\C-i" 'wl-folder-revisit-last-visited-folder) (define-key wl-folder-mode-map "w" 'wl-draft) (define-key wl-folder-mode-map "W" 'wl-folder-write-current-folder) (define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer) @@ -229,19 +232,6 @@ (defmacro wl-folder-buffer-group-p () (` (get-text-property (point) 'wl-folder-is-group))) -(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))))) - (defun wl-folder-buffer-search-group (group) (let ((prev-point (point)) (group-regexp (concat @@ -289,10 +279,7 @@ (and sym (boundp sym))))) (defmacro wl-folder-clear-entity-info (entity &optional hashtb) - (` (let ((sym (intern-soft (, entity) - (or (, hashtb) wl-folder-entity-hashtb)))) - (if (boundp sym) - (makunbound sym))))) + (` (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)))) @@ -336,12 +323,25 @@ 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))) + `(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))))) @@ -615,68 +615,69 @@ Optional argument ARG is repeart count." (interactive "P") (beginning-of-line) (let (entity beg end indent opened fname err fld-name) - (cond - ((and (wl-folder-buffer-group-p) - (looking-at wl-folder-group-regexp)) - (save-excursion - (setq fname (wl-folder-get-entity-from-buffer)) - (setq indent (wl-match-buffer 1)) - (setq opened (wl-match-buffer 2)) - (if (string= opened "+") - (progn - (setq entity (wl-folder-search-group-entity-by-name - fname - wl-folder-entity)) - (setq beg (point)) - (if arg - (wl-folder-update-recursive-current-entity entity) - ;; insert as opened - (setcdr (assoc (car entity) wl-folder-group-alist) t) - (if (eq 'access (cadr entity)) - (wl-folder-maybe-load-folder-list entity)) - ;(condition-case errobj - (progn - (if (or (wl-folder-force-fetch-p (car entity)) - (and - (eq 'access (cadr entity)) - (null (caddr entity)))) - (wl-folder-update-newest indent entity) - (wl-folder-insert-entity indent entity)) - (wl-highlight-folder-path wl-folder-buffer-cur-path)) - ; (quit - ; (setq err t) - ; (setcdr (assoc fname wl-folder-group-alist) nil)) - ; (error - ; (elmo-display-error errobj t) - ; (ding) - ; (setq err t) - ; (setcdr (assoc fname wl-folder-group-alist) nil))) - (if (not err) - (let ((buffer-read-only nil)) - (delete-region (save-excursion (beginning-of-line) - (point)) - (save-excursion (end-of-line) - (+ 1 (point)))))))) - (setq beg (point)) - (end-of-line) - (save-match-data - (setq end - (progn (wl-folder-goto-bottom-of-current-folder indent) - (beginning-of-line) - (point)))) - (setq entity (wl-folder-search-group-entity-by-name - fname - wl-folder-entity)) - (let ((buffer-read-only nil)) - (delete-region beg end)) - (setcdr (assoc (car entity) wl-folder-group-alist) nil) - (wl-folder-insert-entity indent entity) ; insert entity - (forward-line -1) - (wl-highlight-folder-path wl-folder-buffer-cur-path) -; (wl-delete-all-overlays) -; (wl-highlight-folder-current-line) - ))) - ((setq fld-name (wl-folder-entity-name)) + (if (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) + ;; folder group + (save-excursion + (setq fname (wl-folder-get-entity-from-buffer)) + (setq indent (wl-match-buffer 1)) + (setq opened (wl-match-buffer 2)) + (if (string= opened "+") + (progn + (setq entity (wl-folder-search-group-entity-by-name + fname + wl-folder-entity)) + (setq beg (point)) + (if arg + (wl-folder-update-recursive-current-entity entity) + ;; insert as opened + (setcdr (assoc (car entity) wl-folder-group-alist) t) + (if (eq 'access (cadr entity)) + (wl-folder-maybe-load-folder-list entity)) + ;(condition-case errobj + (progn + (if (or (wl-folder-force-fetch-p (car entity)) + (and + (eq 'access (cadr entity)) + (null (caddr entity)))) + (wl-folder-update-newest indent entity) + (wl-folder-insert-entity indent entity)) + (wl-highlight-folder-path wl-folder-buffer-cur-path)) + ; (quit + ; (setq err t) + ; (setcdr (assoc fname wl-folder-group-alist) nil)) + ; (error + ; (elmo-display-error errobj t) + ; (ding) + ; (setq err t) + ; (setcdr (assoc fname wl-folder-group-alist) nil))) + (if (not err) + (let ((buffer-read-only nil)) + (delete-region (save-excursion (beginning-of-line) + (point)) + (save-excursion (end-of-line) + (+ 1 (point)))))))) + (setq beg (point)) + (end-of-line) + (save-match-data + (setq end + (progn (wl-folder-goto-bottom-of-current-folder indent) + (beginning-of-line) + (point)))) + (setq entity (wl-folder-search-group-entity-by-name + fname + wl-folder-entity)) + (let ((buffer-read-only nil)) + (delete-region beg end)) + (setcdr (assoc (car entity) wl-folder-group-alist) nil) + (wl-folder-insert-entity indent entity) ; insert entity + (forward-line -1) + (wl-highlight-folder-path wl-folder-buffer-cur-path) + ; (wl-delete-all-overlays) + ; (wl-highlight-folder-current-line) + )) + ;; ordinal folder + (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 @@ -691,7 +692,7 @@ Optional argument ARG is repeart count." (wl-summary-goto-folder-subr fld-name (wl-summary-get-sync-range (wl-folder-get-elmo-folder fld-name)) - nil arg t))))) + nil arg t)))) (set-buffer-modified-p nil)) (defun wl-folder-close-entity (entity) @@ -823,7 +824,7 @@ 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)) @@ -838,8 +839,10 @@ Optional argument ARG is repeart count." (elmo-folder-diff folder))) (error ;; maybe not exist folder. - (if (and (not (memq 'elmo-open-error - (get (car err) 'error-conditions))) + (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)))))) @@ -863,7 +866,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))) @@ -974,6 +977,9 @@ Optional argument ARG is repeart count." (if buf-win (select-window buf-win) (set-buffer buf)) + (when (and wl-folder-buffer-cur-entity-id + (not (eq wl-folder-buffer-cur-entity-id entity-id))) + (setq wl-folder-buffer-last-visited-entity-id wl-folder-buffer-cur-entity-id)) (setq wl-folder-buffer-cur-entity-id entity-id) (setq wl-folder-buffer-cur-path (wl-folder-get-path wl-folder-entity entity-id)) @@ -1108,7 +1114,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 @@ -1437,7 +1444,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))) @@ -1451,7 +1458,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))) @@ -1752,7 +1759,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) @@ -1805,13 +1814,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 @@ -1824,47 +1831,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))) @@ -2230,17 +2235,29 @@ Use `wl-subscribed-mailing-list'." (set-buffer-modified-p nil)))))) (defun wl-folder-goto-folder (&optional arg) + "Visit some folder." (interactive "P") (wl-folder-goto-folder-subr nil arg)) (defun wl-folder-goto-folder-sticky () + "Visit some folder and make it sticky." (interactive) (wl-folder-goto-folder-subr nil t)) (defun wl-folder-goto-draft-folder (&optional arg) + "Visit draft folder." (interactive "P") (wl-folder-goto-folder-subr wl-draft-folder arg)) +(defun wl-folder-revisit-last-visited-folder (&optional arg) + "Revisit last visited folder." + (interactive "P") + (let ((folder + (wl-folder-get-folder-name-by-id wl-folder-buffer-last-visited-entity-id))) + (if (and folder + (y-or-n-p (format "Revisit %s? " folder))) + (wl-folder-goto-folder-subr folder arg)))) + (defun wl-folder-goto-folder-subr (&optional folder sticky) (beginning-of-line) (let (summary-buf fld-name entity id error-selecting) @@ -2517,7 +2534,7 @@ 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-entity-from-buffer)) @@ -2526,7 +2543,7 @@ Use `wl-subscribed-mailing-list'." 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)) @@ -2753,14 +2770,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) @@ -2849,16 +2863,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)))) @@ -2867,7 +2881,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))))