X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=30b17d6e6b2f0c2c5d74493ab2a4719038cda1fb;hb=8411f54bea43e3cc31632ec94c9777724516d1de;hp=bea3893258e83ef88539d735a0f25f6d105ea5d7;hpb=04809dbb26bc584dd3dfa5c17dcd9f0eae736a37;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index bea3893..30b17d6 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -46,6 +46,11 @@ (require 'wl) (require 'elmo-nntp)) +(defcustom wl-folder-init-hook nil + "A hook called after folder initialization is finished." + :type 'hook + :group 'wl) + (defvar wl-folder-buffer-name "Folder") (defvar wl-folder-entity nil) ; desktop entity. (defvar wl-folder-group-alist nil) ; opened or closed @@ -84,10 +89,14 @@ ["Sync Current Folder" wl-folder-sync-current-entity t] ; ["Drop Current Folder" wl-folder-drop-unsync-current-entity t] ["Prefetch Current Folder" wl-folder-prefetch-current-entity t] + "----" ["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t] ["Expire Current Folder" wl-folder-expire-current-entity t] + "----" + ["Go to Draft Folder" wl-folder-goto-draft-folder t] ["Empty trash" wl-folder-empty-trash t] ["Flush queue" wl-folder-flush-queue t] + "----" ["Open All" wl-folder-open-all t] ["Open All Unread folder" wl-folder-open-all-unread-folder t] ["Close All" wl-folder-close-all t] @@ -105,12 +114,13 @@ ["Display all" wl-fldmgr-access-display-all t]) "----" ["Write a message" wl-draft t] + ["Write for current folder" wl-folder-write-current-folder 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] )) @@ -137,15 +147,19 @@ ; (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close) (define-key wl-folder-mode-map "/" 'wl-folder-open-close) (define-key wl-folder-mode-map "\C-m" 'wl-folder-jump-to-current-entity) + (define-key wl-folder-mode-map [(shift return)] 'wl-folder-jump-to-current-entity-with-arg) (define-key wl-folder-mode-map "\M-\C-m" 'wl-folder-update-recursive-current-entity) (define-key wl-folder-mode-map "rc" 'wl-folder-mark-as-read-all-region) (define-key wl-folder-mode-map "c" 'wl-folder-mark-as-read-all-current-entity) (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 "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) (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) @@ -165,6 +179,8 @@ (define-key wl-folder-mode-map "e" 'wl-folder-expire-current-entity) (define-key wl-folder-mode-map "E" 'wl-folder-empty-trash) (define-key wl-folder-mode-map "F" 'wl-folder-flush-queue) + (define-key wl-folder-mode-map "V" 'wl-folder-virtual) + (define-key wl-folder-mode-map "?" 'wl-folder-pick) (define-key wl-folder-mode-map "q" 'wl-exit) (define-key wl-folder-mode-map "z" 'wl-folder-suspend) (define-key wl-folder-mode-map "\M-t" 'wl-toggle-plugged) @@ -233,7 +249,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]*" @@ -276,7 +293,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)) @@ -300,14 +317,6 @@ (setq li (cdr li)))))))) ;;; ELMO folder structure with cache. -(defmacro wl-folder-get-elmo-folder (entity) - "Get elmo folder structure from 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'." @@ -320,6 +329,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)) @@ -459,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.") @@ -578,6 +597,10 @@ Optional argument ARG is repeart count." (t wl-force-fetch-folders))) +(defun wl-folder-jump-to-current-entity-with-arg () + (interactive) + (wl-folder-jump-to-current-entity t)) + (defun wl-folder-jump-to-current-entity (&optional arg) "Enter the current folder. If optional ARG exists, update folder list." (interactive "P") @@ -793,12 +816,14 @@ Optional argument ARG is repeart count." (run-hooks 'wl-folder-check-entity-hook) ret-val)) -(defun wl-folder-check-one-entity (entity) - (let* ((folder (wl-folder-get-elmo-folder entity)) +(defun wl-folder-check-one-entity (entity &optional biff) + (let* ((folder (wl-folder-get-elmo-folder entity biff)) (nums (condition-case err - (if (wl-string-match-member entity wl-strict-diff-folders) - (elmo-strict-folder-diff folder) - (elmo-folder-diff folder)) + (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 ;; maybe not exist folder. (if (and (not (memq 'elmo-open-error @@ -806,44 +831,33 @@ Optional argument ARG is repeart count." (not (elmo-folder-exists-p folder))) (wl-folder-create-subr folder) (signal (car err) (cdr err)))))) - (new (elmo-diff-new nums)) - (nums (cons (elmo-diff-unread nums) (elmo-diff-all nums))) - unread unsync nomif) + (new (elmo-diff-new nums)) + (unread (elmo-diff-unread nums)) + (all (elmo-diff-all nums)) + unsync nomif) (if (and (eq wl-folder-notify-deleted 'sync) - (car nums) - (or (> 0 (car nums)) (> 0 (cdr nums)))) + (or (and new (> 0 new)) + (and unread (> 0 unread)) + (and all (> 0 all)))) (progn (wl-folder-sync-entity entity) - (setq nums (elmo-folder-diff folder))) + (setq nums (elmo-folder-diff folder) + new (elmo-diff-new nums) + unread (elmo-diff-unread nums) + all (elmo-diff-all nums))) (unless wl-folder-notify-deleted - (setq unsync (if (car nums) - (max 0 (car nums)) - nil)) - (setq nomif (if (cdr nums) - (max 0 (cdr nums)) - nil)) - (setq nums (cons unsync nomif))) - (setq unread (or ;; If server diff, All unreads are - ; treated as unsync. - (if (elmo-folder-use-flag-p folder) - (car nums)) - (elmo-folder-get-info-unread folder) - (wl-summary-count-unread (elmo-msgdb-mark-load - (elmo-folder-msgdb-path - folder))))) - (when new (setq unread (- unread new))) + (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) + (cdr (wl-summary-count-unread)))) (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity - (list (or new (car nums)) - unread - (cdr nums)) + (list new unread all) (get-buffer wl-folder-buffer-name))) (setq wl-folder-info-alist-modified t) (sit-for 0) - (list (if wl-folder-notify-deleted - (or new (car nums)) - (max 0 (or new (car nums)))) - unread - (cdr nums)))) + (list new unread all))) (defun wl-folder-check-entity-async (entity &optional auto) (let ((elmo-nntp-groups-async t) @@ -1012,7 +1026,7 @@ If current line is group folder, check all subfolders." (let ((entity-name (wl-folder-get-entity-from-buffer)) (group (wl-folder-buffer-group-p))) (when (and entity-name - (y-or-n-p (format "Sync %s?" entity-name))) + (y-or-n-p (format "Sync %s? " entity-name))) (wl-folder-sync-entity (if group (wl-folder-search-group-entity-by-name entity-name @@ -1063,7 +1077,7 @@ 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 @@ -1462,8 +1476,16 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (switch-to-buffer folder-buf))) (switch-to-buffer folder-buf)) (if wl-folder-use-frame - (switch-to-buffer-other-frame - (get-buffer-create wl-folder-buffer-name)) + (progn + (switch-to-buffer-other-frame + (get-buffer-create wl-folder-buffer-name)) + (let ((frame (selected-frame))) + (setq wl-delete-startup-frame-function + `(lambda () + (setq wl-delete-startup-frame-function nil) + (let ((frame ,frame)) + (if (eq (selected-frame) frame) + (delete-frame frame))))))) (switch-to-buffer (get-buffer-create wl-folder-buffer-name))) (set-buffer wl-folder-buffer-name) (wl-folder-mode) @@ -1571,7 +1593,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (when (setq new-flist (elmo-folder-list-subfolders (wl-folder-get-elmo-folder (car entity)) - (wl-string-member + (wl-string-match-member (car entity) wl-folder-hierarchy-access-folders))) (setq update-flist @@ -1996,7 +2018,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (interactive) (if wl-use-acap (wl-acap-init) - (funcall wl-folder-init-function))) + (funcall wl-folder-init-function)) + (run-hooks 'wl-folder-init-hook)) (defun wl-local-folder-init () "Initialize local folder." @@ -2172,6 +2195,14 @@ Use `wl-subscribed-mailing-list'." (interactive "P") (wl-folder-goto-folder-subr nil arg)) +(defun wl-folder-goto-folder-sticky () + (interactive) + (wl-folder-goto-folder-subr nil t)) + +(defun wl-folder-goto-draft-folder (&optional arg) + (interactive "P") + (wl-folder-goto-folder-subr wl-draft-folder arg)) + (defun wl-folder-goto-folder-subr (&optional folder sticky) (beginning-of-line) (let (summary-buf fld-name entity id error-selecting) @@ -2180,7 +2211,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 @@ -2207,6 +2239,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 () @@ -2466,6 +2502,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))) @@ -2484,6 +2521,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))) @@ -2729,7 +2767,7 @@ If current line is group folder, all subfolders are prefetched." ; summary-buf entity) ; (when (and entity-name ; (y-or-n-p (format -; "Drop all unsync messages in %s?" entity-name))) +; "Drop all unsync messages in %s? " entity-name))) ; (setq entity ; (if group ; (wl-folder-search-group-entity-by-name entity-name @@ -2761,19 +2799,19 @@ Call `wl-summary-write-current-folder' with current folder name." (kill-buffer bufname)))) (defun wl-folder-create-subr (folder) - (if (not (elmo-folder-creatable-p folder)) - (error "Folder %s is not found" (elmo-folder-name-internal folder)) - (if (y-or-n-p - (format "Folder %s does not exist, create it?" - (elmo-folder-name-internal folder))) - (progn - (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))))) + (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)))) (defun wl-folder-confirm-existence (folder &optional force) (if force @@ -2784,6 +2822,74 @@ Call `wl-summary-write-current-folder' with current folder name." (elmo-folder-exists-p folder)) (wl-folder-create-subr folder)))) +(defun wl-folder-virtual () + "Goto virtual folder." + (interactive) + (let ((entity (wl-folder-get-entity-from-buffer))) + (if (wl-folder-buffer-group-p) + (setq entity + (concat + "*" + (mapconcat 'identity + (wl-folder-get-entity-list + (wl-folder-search-group-entity-by-name + entity + wl-folder-entity)) ",")))) + (unless entity (error "No folder")) + (wl-folder-goto-folder-subr + (concat "/" + (elmo-read-search-condition + wl-fldmgr-make-filter-default) + "/" entity)))) + +(defun wl-folder-pick () + (interactive) + (save-excursion + (let* ((condition (car (elmo-parse-search-condition + (elmo-read-search-condition + wl-summary-pick-field-default)))) + (entity (wl-folder-get-entity-from-buffer)) + (folder-list + (if (wl-folder-buffer-group-p) + (wl-folder-get-entity-list + (wl-folder-search-group-entity-by-name + entity + wl-folder-entity)) + (list entity))) + results ret) + (while (car folder-list) + (setq ret (elmo-folder-search + (wl-folder-get-elmo-folder (car folder-list)) + condition)) + (if ret + (setq results + (append results + (list (cons (car folder-list) ret))))) + (setq folder-list (cdr folder-list))) + (if results + (message "%s are picked." + (mapconcat '(lambda (res) + (format "%s(%d)" + (car res) + (length (cdr res)))) + results + ",")) + (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))