X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=262db0d0f7c2c1220a7464ee861e0453bacac22a;hb=d3625675e111e4b78e6700da36bebb318ffbae22;hp=a381b7ba222017d5c4fafa2d9284e58bec2ca525;hpb=daa91c5e916915b334ff48938f3be1316bbf2ab9;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index a381b7b..262db0d 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -116,11 +116,13 @@ ["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] "----" ["Save Current Status" wl-save t] - ["Update Satus" wl-status-update t] + ["Update Status" wl-status-update t] ["Exit" wl-exit t] )) @@ -158,6 +160,8 @@ (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) (define-key wl-folder-mode-map "\C-c\C-a" 'wl-addrmgr) + (define-key wl-folder-mode-map "\C-c\C-p" 'wl-folder-jump-to-previous-summary) + (define-key wl-folder-mode-map "\C-c\C-n" 'wl-folder-jump-to-next-summary) (define-key wl-folder-mode-map "rS" 'wl-folder-sync-region) (define-key wl-folder-mode-map "S" 'wl-folder-sync-current-entity) (define-key wl-folder-mode-map "rs" 'wl-folder-check-region) @@ -247,7 +251,8 @@ (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t)) (defun wl-folder-buffer-search-entity (folder &optional searchname) - (let ((search (or searchname (wl-folder-get-petname folder)))) + (let ((search (or searchname (wl-folder-get-petname folder))) + case-fold-search) (re-search-forward (concat "^[ \t]*" @@ -290,7 +295,7 @@ (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 (, entity) + (elmo-set-hash-val (elmo-string (, entity)) (if (< (length (, value)) 4) (append (, value) (list (nth 3 info))) (, value)) @@ -314,16 +319,6 @@ (setq li (cdr li)))))))) ;;; ELMO folder structure with cache. -(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))) - (folder (elmo-make-folder name))) - (wl-folder-elmo-folder-cache-put name folder) - folder))))) - (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'." @@ -336,6 +331,16 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (` (elmo-set-hash-val (, name) (, folder) (or (, hashtb) wl-folder-elmo-folder-hashtb)))) +(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))) + (folder (elmo-make-folder name))) + (wl-folder-elmo-folder-cache-put name folder) + folder))))) + (defun wl-folder-prev-entity () (interactive) (forward-line -1)) @@ -345,7 +350,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)) @@ -425,8 +430,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (setq entities (nth 2 entity))) ((stringp entity) (if (and (string= name entity) - ;; don't use eq, `id' is string on Nemacs. - (equal id (wl-folder-get-entity-id entity))) + (eq id (wl-folder-get-entity-id entity))) (throw 'done last-entity)) (if (or (not unread) (and (setq finfo (wl-folder-get-entity-info entity)) @@ -461,8 +465,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (> (+ (nth 0 finfo)(nth 1 finfo)) 0))) (throw 'done entity)) (if (and (string= name entity) - ;; don't use eq, `id' is string on Nemacs. - (equal id (wl-folder-get-entity-id entity))) + (eq id (wl-folder-get-entity-id entity))) (setq found t))))) (unless entities (setq entities (wl-pop entity-stack))))))) @@ -475,7 +478,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (wl-plugged t) emptied) (if elmo-enable-disconnected-operation - (elmo-dop-queue-flush 'force)) ; Try flushing all queue. + (elmo-dop-queue-flush)) (if (not (elmo-folder-list-messages (wl-folder-get-elmo-folder wl-queue-folder))) (message "No sending queue exists.") @@ -498,11 +501,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 @@ -848,9 +851,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 - (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder)))))) + (cdr (wl-summary-count-unread)))) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity (list new unread all) (get-buffer wl-folder-buffer-name))) @@ -953,21 +954,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. @@ -999,14 +1000,21 @@ If current line is group folder, check all sub entries." (wl-summary-always-sticky-folder-p folder)) wl-summary-highlight)) - wl-auto-select-first new unread) + 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 (concat - wl-summary-buffer-name - (symbol-name this-command))) + (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 @@ -1015,7 +1023,9 @@ If current line is group folder, check all sub entries." (wl-summary-get-sync-range folder) nil nil nil t) - (wl-summary-exit))))))))) + (if sticky + (wl-summary-save-status) + (wl-summary-exit)))))))))) (defun wl-folder-sync-current-entity (&optional unread-only) "Synchronize the folder at position. @@ -1049,22 +1059,32 @@ If current line is group folder, check all subfolders." (wl-summary-always-sticky-folder-p folder)) wl-summary-highlight)) - wl-auto-select-first new unread) + 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 (concat - wl-summary-buffer-name - (symbol-name this-command))) + (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) - (wl-summary-exit)))) + (if sticky + (wl-summary-save-status) + (wl-summary-exit))))) (sit-for 0)))))) (defun wl-folder-mark-as-read-all-current-entity () @@ -1932,8 +1952,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (cond ((consp entity) (if (and (or (not string) (string= string (car entity))) - ;; don't use eq, `id' is string on Nemacs. - (equal target-id (wl-folder-get-entity-id (car entity)))) + (eq target-id (wl-folder-get-entity-id (car entity)))) (throw 'done (wl-push target-id result-path)) (wl-push (wl-folder-get-entity-id (car entity)) result-path)) @@ -1941,8 +1960,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (setq entities (nth 2 entity))) ((stringp entity) (if (and (or (not string) (string= string entity)) - ;; don't use eq, `id' is string on Nemacs. - (equal target-id (wl-folder-get-entity-id entity))) + (eq target-id (wl-folder-get-entity-id entity))) (throw 'done (wl-push target-id result-path))))) (unless entities @@ -2058,7 +2076,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 @@ -2096,7 +2114,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 @@ -2210,7 +2228,8 @@ Use `wl-subscribed-mailing-list'." ;;; (assoc fld-name wl-folder-group-alist)) (setq fld-name wl-default-folder) (setq fld-name (or folder - (wl-summary-read-folder fld-name))) + (let (this-command) + (wl-summary-read-folder fld-name)))) (if (and (setq entity (wl-folder-search-entity-by-name fld-name wl-folder-entity @@ -2237,6 +2256,10 @@ Use `wl-subscribed-mailing-list'." ;(if (fboundp 'mmelmo-cleanup-entity-buffers) ;(mmelmo-cleanup-entity-buffers)) (bury-buffer wl-folder-buffer-name) + (dolist (summary-buf (wl-collect-summary)) + (bury-buffer summary-buf)) + (dolist (draft-buf (wl-collect-draft)) + (bury-buffer draft-buf)) (delete-windows-on wl-folder-buffer-name t)) (defun wl-folder-info-save () @@ -2496,6 +2519,7 @@ Use `wl-subscribed-mailing-list'." (when (> len elmo-display-progress-threshold) (elmo-display-progress 'wl-folder-open-all "Opening all folders..." 100)))) + (wl-highlight-folder-path wl-folder-buffer-cur-path) (message "Opening all folders...done") (set-buffer-modified-p nil))) @@ -2514,6 +2538,7 @@ Use `wl-subscribed-mailing-list'." (erase-buffer) (wl-folder-insert-entity " " wl-folder-entity) (wl-folder-move-path id) + (wl-highlight-folder-path wl-folder-buffer-cur-path) (recenter) (set-buffer-modified-p nil))) @@ -2674,16 +2699,24 @@ Use `wl-subscribed-mailing-list'." wl-summary-highlight)) wl-summary-exit-next-move wl-auto-select-first ret-val - count) + count sticky) (setq count (or (car nums) 0)) (setq count (+ count (wl-folder-count-incorporates folder))) (if (or (null (car nums)) ; unknown (< 0 count)) (save-window-excursion (save-excursion - (let ((wl-summary-buffer-name (concat - wl-summary-buffer-name - (symbol-name this-command))) + (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 @@ -2691,7 +2724,9 @@ Use `wl-subscribed-mailing-list'." folder) nil) (setq ret-val (wl-summary-incorporate)) - (wl-summary-exit) + (if sticky + (wl-summary-save-status) + (wl-summary-exit)) ret-val))) (cons 0 0)))))) @@ -2791,6 +2826,7 @@ 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 @@ -2801,7 +2837,8 @@ Call `wl-summary-write-current-folder' with current folder name." 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 is not created" (elmo-folder-name-internal folder))) + (error "Folder %s does not exist" (elmo-folder-name-internal folder)))) (defun wl-folder-confirm-existence (folder &optional force) (if force @@ -2866,6 +2903,20 @@ Call `wl-summary-write-current-folder' with current folder name." ",")) (message "No message was picked."))))) +(defun wl-folder-jump-to-next-summary () + (interactive) + (when (wl-collect-summary) + (if (get-buffer-window (car (wl-collect-summary))) + (switch-to-buffer-other-window (car (wl-collect-summary)))) + (wl-summary-next-buffer))) + +(defun wl-folder-jump-to-previous-summary () + (interactive) + (when (wl-collect-summary) + (if (get-buffer-window (car (wl-collect-summary))) + (switch-to-buffer-other-window (car (wl-collect-summary)))) + (wl-summary-previous-buffer))) + (require 'product) (product-provide (provide 'wl-folder) (require 'wl-version))