(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)
["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]
"----"
""))))
(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)))
(` (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))
(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))
(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)))))))
(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
(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 "+")
; (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
(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))
(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))
(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))))))
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)))
(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.
(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.
(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
(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
(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))
(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)
(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)))
(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)))
;;; 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
(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)
(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)
(+ (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)))))
(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
(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)))
(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
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
(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
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
(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))
(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
(+ (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)
(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))
(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))
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))))))
(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)
(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."
(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))))
(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))))
(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))