-;;; wl-folder.el -- Folder mode for Wanderlust.
+;;; wl-folder.el --- Folder mode for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
(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
["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]
["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]
))
; (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)
(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)
(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]*"
entity (or hashtb wl-folder-entity-id-name-hashtb))))
(defmacro wl-folder-get-entity-id (entity)
- (` (or (get-text-property 0
- 'wl-folder-entity-id
- (, entity))
- (, entity)))) ;; for nemacs
+ `(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 (not id) ;; for nemacs
- (wl-folder-get-realname (wl-folder-folder-name))
- (if (, getid)
- id
- (wl-folder-get-folder-name-by-id id))))))
+ `(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)
(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))
(defun wl-folder-persistent-p (folder)
(or (and (wl-folder-search-entity-by-name folder wl-folder-entity
'folder)
- t) ; on Folder mode.
+ t) ; on Folder mode.
(catch 'found
(let ((li wl-save-folder-list))
(while li
(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'."
(` (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))
(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))
(> (+ (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)))))))
(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.")
(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")
(run-hooks 'wl-folder-check-entity-hook)
ret-val))
-(defun wl-folder-check-one-entity (entity)
- (let* ((folder (wl-folder-get-elmo-folder entity))
- (nums (condition-case err
- (if (wl-string-match-member entity wl-strict-diff-folders)
- (elmo-strict-folder-diff folder)
- (elmo-folder-diff folder))
- (error
+(defun wl-folder-check-one-entity (entity &optional biff)
+ (let* ((folder (wl-folder-get-elmo-folder entity biff))
+ (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
;; 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))))))
- (new (elmo-diff-new nums))
- (nums (cons (elmo-diff-unread nums) (elmo-diff-all nums)))
- unread unsync nomif)
+ ; (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))))))
+ )
+ (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 (and (car nums) (> 0 (car nums))) 0 (car nums)))
- (setq nomif (if (and (car nums) (> 0 (cdr nums))) 0 (cdr nums)))
- (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)))))
- (setq unread (min unread (- (or (cdr nums) 0) (or (car nums) 0))))
- (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
- (car nums)
- (or new (max (or (car nums) 0)))) unread (cdr nums))))
+ (list new unread all)))
(defun wl-folder-check-entity-async (entity &optional auto)
(let ((elmo-nntp-groups-async t)
(setq ret-val
(wl-folder-add-folder-info
ret-val
- (wl-folder-check-one-entity (elmo-folder-name-internal
+ (wl-folder-check-one-entity (elmo-folder-name-internal
folder))))
;;(sit-for 0)
))
(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
(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.
(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
(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 ()
(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
(use-local-map wl-folder-mode-map)
(setq buffer-read-only t)
(setq inhibit-read-only nil)
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
(setq truncate-lines t)
(setq wl-folder-buffer-cur-entity-id nil
wl-folder-buffer-cur-path nil
(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)
(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
(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))
(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))
(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
(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."
(defun wl-folder-get-newsgroups (folder)
"Return Newsgroups field value string for FOLDER newsgroup.
If FOLDER is multi, return comma separated string (cross post)."
- (let ((flist (elmo-folder-get-primitive-list
- (wl-folder-get-elmo-folder folder))) ; multi
- newsgroups fld ret)
- (while (setq fld (car flist))
- (if (setq ret
- (cond ((eq 'nntp (elmo-folder-type-internal fld))
- (elmo-nntp-folder-group-internal fld))
- ((eq 'localnews (elmo-folder-type-internal fld))
- (elmo-replace-in-string
- (elmo-nntp-folder-group-internal fld)
- "/" "\\."))))
- ;; append newsgroup
- (setq newsgroups (if (stringp newsgroups)
- (concat newsgroups "," ret)
- ret)))
- (setq flist (cdr flist)))
- (list nil nil newsgroups)))
+ (let ((nlist (elmo-folder-newsgroups
+ (wl-folder-get-elmo-folder folder))))
+ (if nlist
+ (list nil nil (mapconcat 'identity nlist ","))
+ nil)))
(defun wl-folder-guess-mailing-list-by-refile-rule (entity)
"Return ML address guess by FOLDER.
(let ((flist
(elmo-folder-get-primitive-list
(wl-folder-get-elmo-folder entity)))
- fld ret mlist)
+ fld mladdr to)
(while (setq fld (car flist))
- (if (setq ret
- (wl-folder-guess-mailing-list-by-refile-rule-subr
- (elmo-folder-name-internal fld)))
- (setq mlist (if (stringp mlist)
- (concat mlist ", " ret)
- ret)))
+ (setq mladdr (wl-folder-guess-mailing-list-by-refile-rule-subr
+ (elmo-folder-name-internal fld)))
+ (when mladdr
+ (setq to (if (stringp to)
+ (concat to ", " mladdr)
+ mladdr)))
(setq flist (cdr flist)))
- (if mlist
- (list mlist nil nil))))
+ (if (stringp to)
+ (list to nil nil)
+ nil)))
(defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity)
(unless (memq (elmo-folder-type entity)
(let ((flist
(elmo-folder-get-primitive-list
(wl-folder-get-elmo-folder entity)))
- fld ret mlist)
+ fld mladdr to)
(while (setq fld (car flist))
- (if (setq ret
- (wl-folder-guess-mailing-list-by-folder-name-subr
- (elmo-folder-name-internal fld)))
- (setq mlist (if (stringp mlist)
- (concat mlist ", " ret)
- ret)))
+ (setq mladdr (wl-folder-guess-mailing-list-by-folder-name-subr
+ (elmo-folder-name-internal fld)))
+ (when mladdr
+ (setq to (if (stringp to)
+ (concat to ", " mladdr)
+ mladdr)))
(setq flist (cdr flist)))
- (if mlist
- (list mlist nil nil))))
+ (if (stringp to)
+ (list to nil nil)
+ nil)))
(defun wl-folder-guess-mailing-list-by-folder-name-subr (entity)
(when (memq (elmo-folder-type entity)
(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)
;;; (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
(wl-summary-get-sync-range
(wl-folder-get-elmo-folder fld-name))
nil sticky t)))
-
+
(defun wl-folder-suspend ()
(interactive)
(run-hooks 'wl-folder-suspend-hook)
;(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 ()
(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)))
(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)))
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
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))))))
; 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
(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
(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))
projects / elisp / wanderlust.git / blobdiff