(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)
(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)
(defconst wl-folder-entity-regexp "^\\([ ]*\\)\\(\\[[\\+-]\\]\\)?\\([^\\[].+\\):[-*0-9]+/[-*0-9]+/[-*0-9]+")
-(defconst wl-folder-group-regexp "^\\([ ]*\\)\\[\\([\\+-]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n")
+(defconst wl-folder-group-regexp "^\\([ ]*\\)\\[\\([\\+-]\\)\\]\\(.+\\):[0-9-]+/[0-9-]+/[0-9-]+\n")
;; 1:indent 2:opened 3:group-name
(defconst wl-folder-unsync-regexp ":[^0\\*][0-9]*/[0-9\\*-]+/[0-9\\*-]+$")
["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]
"----"
(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)
(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 "x" 'wl-execute-temp-marks)
(define-key wl-folder-mode-map "\M-t" 'wl-toggle-plugged)
(define-key wl-folder-mode-map "\C-t" 'wl-plugged-change)
(define-key wl-folder-mode-map "<" 'beginning-of-buffer)
""))))
(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))))
- (re-search-forward
- (concat
- "^[ \t]*"
- (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+") nil t)))
+ (let ((search (or searchname (wl-folder-get-petname folder)))
+ case-fold-search
+ result)
+ (catch 'found
+ (while (setq result
+ (re-search-forward
+ (concat
+ "^[ \t]*"
+ (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+")
+ nil t))
+ (when (string= (wl-folder-get-entity-from-buffer) folder)
+ (throw 'found result))))))
(defsubst wl-folder-get-folder-name-by-id (entity-id &optional hashtb)
(and (numberp entity-id)
(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))))
(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))
(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'."
(` (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 (wl-folder-make-elmo-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))
+
+(defun wl-folder-mime-charset (folder-name)
+ (or (wl-get-assoc-list-value wl-folder-mime-charset-alist folder-name)
+ wl-mime-charset))
+
+(defun wl-folder-make-elmo-folder (folder-name)
+ (elmo-make-folder folder-name nil (wl-folder-mime-charset folder-name)))
+
+(defsubst wl-folder-get-elmo-folder (entity &optional no-cache)
+ "Get elmo folder structure from ENTITY."
+ (let ((name (elmo-string entity)))
+ (if no-cache
+ (wl-folder-make-elmo-folder name)
+ (if (string= name wl-draft-folder)
+ (wl-draft-get-folder)
+ (or (wl-folder-elmo-folder-cache-get name)
+ (let ((folder (wl-folder-make-elmo-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)))))))
(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.")
(wl-folder-toggle-disp-summary 'off wl-queue-folder)
(switch-to-buffer cur-buf))))))
+(defun wl-folder-set-persistent-mark (folder number flag)
+ "Set a persistent mark which corresponds to the specified flag on message."
+ (let ((buffer (wl-summary-get-buffer folder)))
+ (if buffer
+ (with-current-buffer buffer
+ (wl-summary-set-persistent-mark flag number))
+ ;; Parent buffer does not exist.
+ (let ((elmo-folder (wl-folder-get-elmo-folder folder)))
+ (elmo-folder-open elmo-folder 'load-msgdb)
+ (elmo-folder-set-flag elmo-folder (list wl-draft-parent-number) flag)
+ (elmo-folder-close elmo-folder)))))
+
(defun wl-folder-empty-trash ()
"Empty trash."
(interactive)
(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
(throw 'done t))
(goto-char (point-max))))
-(defsubst wl-folder-update-group (entity diffs &optional is-group)
+(defun wl-folder-update-group (entity diffs &optional is-group)
(save-excursion
(let ((path (wl-folder-get-path
wl-folder-entity
(defun wl-folder-jump-to-current-entity (&optional arg)
"Enter the current folder. If optional ARG exists, update folder list."
(interactive "P")
- (beginning-of-line)
- (let (entity beg end indent opened fname err fld-name)
- (cond
- ((looking-at wl-folder-group-regexp)
- (save-excursion
- (setq fname (wl-folder-get-realname (wl-match-buffer 3)))
- (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))
+ (let ((fld-name (wl-folder-get-entity-from-buffer))
+ entity beg end indent opened err)
+ (unless fld-name
+ (error "No folder"))
+ (beginning-of-line)
+ (if (and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp))
+ ;; folder group
+ (save-excursion
+ (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
+ fld-name
+ 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 fld-name wl-folder-group-alist) nil))
+ ; (error
+ ; (elmo-display-error errobj t)
+ ; (ding)
+ ; (setq err t)
+ ; (setcdr (assoc fld-name 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
+ fld-name
+ 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
(wl-folder-set-current-entity-id
(get-text-property (point) 'wl-folder-entity-id))
(setq fld-name (wl-folder-get-folder-name-by-id
(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)
(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))
(if (wl-string-match-member entity wl-strict-diff-folders)
(elmo-strict-folder-diff folder)
(elmo-folder-diff folder)))
+ (elmo-open-error
+ (signal (car err) (cdr err)))
(error
;; maybe not exist folder.
- (if (and (not (memq 'elmo-open-error
- (get (car err) 'error-conditions)))
- (not (elmo-folder-exists-p folder)))
+ (if (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)
+ (all (elmo-diff-all nums)))
(if (and (eq wl-folder-notify-deleted 'sync)
(or (and new (> 0 new))
(and unread (> 0 unread))
(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
- (elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb folder))))))
+ (setq unread (if unread
+ (- unread (or new 0))
+ (or (elmo-folder-get-info-unread folder)
+ (cdr (assq 'unread (elmo-folder-count-flags folder)))
+ 0)))
(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))
+ (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))
+ (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.
((stringp entity)
(let* ((folder (wl-folder-get-elmo-folder entity))
(nums (wl-folder-get-entity-info entity))
- (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
- (wl-summary-always-sticky-folder-p
- folder))
- wl-summary-highlight))
- wl-auto-select-first new unread)
- (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)))
- (wl-summary-use-frame nil)
- (wl-summary-always-sticky-folder-list nil))
- (save-window-excursion
- (save-excursion
- (wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range
- folder)
- nil nil nil t)
- (wl-summary-exit)))))))))
+ (new (or (car nums) 0))
+ (unread (or (cadr nums) 0)))
+ (when (or (not unread-only)
+ (or (> new 0) (> unread 0)))
+ (let ((summary (wl-summary-get-buffer entity))
+ (range (wl-summary-get-sync-range folder)))
+ (if summary
+ (save-selected-window
+ (with-current-buffer summary
+ (let ((win (get-buffer-window summary t)))
+ (when win
+ (select-window win)))
+ (wl-summary-sync 'unset-cursor range)
+ (wl-summary-save-status)))
+ (elmo-folder-open folder 'load-msgdb)
+ (unwind-protect
+ (progn
+ (elmo-folder-synchronize folder nil (eq range 'all))
+ (wl-folder-set-folder-updated
+ entity
+ (list
+ 0
+ (or (cdr (assq 'unread (elmo-folder-count-flags folder)))
+ 0)
+ (elmo-folder-length folder))))
+ (elmo-folder-close folder)))))))))
(defun wl-folder-sync-current-entity (&optional unread-only)
"Synchronize the folder at position.
(wl-folder-mark-as-read-all-entity (car flist))
(setq flist (cdr flist)))))
((stringp entity)
- (let* ((nums (wl-folder-get-entity-info entity))
- (folder (wl-folder-get-elmo-folder entity))
- (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
- (wl-summary-always-sticky-folder-p
- folder))
- wl-summary-highlight))
- wl-auto-select-first new unread)
- (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)))
- (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))))
- (sit-for 0))))))
+ (let* ((folder (wl-folder-get-elmo-folder entity))
+ (nums (wl-folder-get-entity-info entity))
+ (new (or (car nums) 0))
+ (unread (or (cadr nums) 0)))
+ (when (or (> new 0) (> unread 0))
+ (let ((summary (wl-summary-get-buffer entity))
+ (range (wl-summary-get-sync-range folder)))
+ (if summary
+ (save-selected-window
+ (with-current-buffer summary
+ (let ((win (get-buffer-window summary t)))
+ (when win
+ (select-window win)))
+ (wl-summary-sync 'unset-cursor range)
+ (wl-summary-mark-as-read-all)
+ (wl-summary-save-status)))
+ (elmo-folder-open folder 'load-msgdb)
+ (unwind-protect
+ (progn
+ (elmo-folder-synchronize folder nil (eq range 'all))
+ (elmo-folder-unset-flag
+ folder
+ (elmo-folder-list-flagged folder 'unread 'in-msgdb)
+ 'unread)
+ (wl-folder-set-folder-updated
+ entity
+ (list 0 0 (elmo-folder-length folder))))
+ (elmo-folder-close folder)))))))))
(defun wl-folder-mark-as-read-all-current-entity ()
"Mark as read all messages in the folder at position.
(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))
+ (car entity) hashtb)
+ (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)))
(and entities
(wl-push entities entity-stack))
(setq entities (nth 2 entity)))
(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))
+ entity hashtb)
+ (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)))))
(unless entities
(setq entities (wl-pop entity-stack))))))
;; hide wl-summary window.
(let ((cur-buf (current-buffer))
(summary-buffer (wl-summary-get-buffer folder)))
- (wl-folder-select-buffer summary-buffer)
- (delete-window)
+ (when summary-buffer
+ (wl-folder-select-buffer summary-buffer)
+ (delete-window))
(select-window (get-buffer-window cur-buf))))
(t
(setq wl-folder-buffer-disp-summary
(unwind-protect
(wl-summary-goto-folder-subr folder-name 'no-sync nil)
(select-window (get-buffer-window cur-buf))))
- (wl-folder-select-buffer (wl-summary-get-buffer folder-name))
- (delete-window)
- (select-window (get-buffer-window cur-buf)))))))))
+ (let ((summary-buffer (wl-summary-get-buffer folder-name)))
+ (when summary-buffer
+ (wl-folder-select-buffer summary-buffer)
+ (delete-window))
+ (select-window (get-buffer-window cur-buf))))))))))
(defun wl-folder-prev-unsync ()
"Move cursor to the previous unsync folder."
(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)))
(run-hooks 'wl-folder-mode-hook))
(defun wl-folder-append-petname (realname petname)
- (let (pentry)
- ;; check group name.
- (if (wl-folder-search-group-entity-by-name petname wl-folder-entity)
- (error "%s already defined as group name" petname))
- (when (setq pentry (wl-string-assoc realname wl-folder-petname-alist))
+ (let ((pentry (wl-string-assoc realname wl-folder-petname-alist)))
+ (when pentry
(setq wl-folder-petname-alist
- (delete pentry wl-folder-petname-alist)))
- (wl-append wl-folder-petname-alist
- (list (cons realname petname)))))
+ (delete pentry wl-folder-petname-alist))))
+ (wl-append wl-folder-petname-alist
+ (list (cons realname petname))))
-(defun wl-folder (&optional arg)
- (interactive "P")
+(defun wl-folder ()
(let (initialize folder-buf)
(if (setq folder-buf (get-buffer wl-folder-buffer-name))
(if wl-folder-use-frame
(set-buffer wl-folder-buffer-name)
(wl-folder-mode)
;; Initialization.
+ (unless wl-folder-entity
+ (wl-folder-init))
(setq wl-folder-entity-id 0)
(wl-folder-entity-assign-id wl-folder-entity)
(setq wl-folder-entity-hashtb
(defun wl-folder-set-folder-updated (name value)
(save-excursion
- (let (buf)
- (if (setq buf (get-buffer wl-folder-buffer-name))
+ (let ((buf (get-buffer wl-folder-buffer-name)))
+ (if buf
(wl-folder-entity-hashtb-set
wl-folder-entity-hashtb name value buf))
(setq wl-folder-info-alist-modified t))))
;;; 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
(wl-highlight-folder-current-line))
(setq removed (cdr removed)))
(remove-text-properties beg (point) '(wl-folder-entity-id)))
- (let* ((len (length flist))
- (mes (> len 100))
- (i 0))
+ (elmo-with-progress-display
+ (wl-folder-insert-entity (length flist))
+ (format "Inserting group %s" (car entity))
(while flist
(setq ret-val
(wl-folder-insert-entity
(setq new (+ (or new 0) (or (nth 0 ret-val) 0)))
(setq unread (+ (or unread 0) (or (nth 1 ret-val) 0)))
(setq all (+ (or all 0) (or (nth 2 ret-val) 0)))
- (when (and mes
- (> len elmo-display-progress-threshold))
- (setq i (1+ i))
- (elmo-display-progress
- 'wl-folder-insert-entity "Inserting group %s..."
- (/ (* i 100) len) (car entity)))
+ (elmo-progress-notify 'wl-folder-insert-entity)
(setq flist (cdr flist))))
(save-excursion
(goto-char group-name-end)
(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
(when wl-smtp-posting-server
(elmo-set-plugged wl-plugged
wl-smtp-posting-server ; server
- (or (and (boundp 'smtp-service) smtp-service)
+ (or wl-smtp-posting-port
+ (and (boundp 'smtp-service) smtp-service)
"smtp") ; port
wl-smtp-connection-type
nil nil "smtp" add))
(when wl-nntp-posting-server
(elmo-set-plugged wl-plugged
wl-nntp-posting-server
- wl-nntp-posting-stream-type
wl-nntp-posting-port
+ wl-nntp-posting-stream-type
nil nil "nntp" add))
(run-hooks 'wl-make-plugged-hook)))
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)
(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)
;;; (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
(interactive)
(if (not fld-name)
(setq fld-name (wl-summary-read-folder wl-default-folder)))
- (let* ((id (wl-folder-get-entity-id
- (wl-folder-search-entity-by-name fld-name wl-folder-entity
- 'folder)))
- (path (and id (wl-folder-get-path wl-folder-entity id))))
- (if path
- (wl-folder-open-folder-sub path))))
+ (let ((entity (wl-folder-search-entity-by-name
+ fld-name wl-folder-entity 'folder)))
+ (if entity
+ (let* ((id (wl-folder-get-entity-id entity))
+ (path (and id (wl-folder-get-path wl-folder-entity id))))
+ (if path (wl-folder-open-folder-sub path)))
+ (message "%s: not found" fld-name))))
(defun wl-folder-open-folder-sub (path)
(let ((inhibit-read-only t)
(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))
(erase-buffer)
(wl-folder-insert-entity " " wl-folder-entity)
(wl-folder-move-path id))
- (message "Opening all folders...")
- (wl-folder-open-all-pre)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n"
- nil t)
- (setq indent (wl-match-buffer 1))
- (setq name (wl-folder-get-realname (wl-match-buffer 3)))
- (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)
- (wl-folder-insert-entity indent entity)
- (delete-region (save-excursion (beginning-of-line)
- (point))
- (save-excursion (end-of-line)
- (+ 1 (point))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 5)) (= i len))
- (elmo-display-progress
- 'wl-folder-open-all "Opening all folders..."
- (/ (* i 100) len)))))
- (when (> len elmo-display-progress-threshold)
- (elmo-display-progress
- 'wl-folder-open-all "Opening all folders..." 100))))
- (message "Opening all folders...done")
+ (elmo-with-progress-display
+ (wl-folder-open-all (length wl-folder-group-alist))
+ "Opening all folders"
+ (wl-folder-open-all-pre)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$"
+ nil t)
+ (setq indent (wl-match-buffer 1))
+ (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)
+ (beginning-of-line)
+ (wl-folder-insert-entity indent entity)
+ (delete-region (save-excursion (beginning-of-line)
+ (point))
+ (save-excursion (end-of-line)
+ (+ 1 (point))))
+ (elmo-progress-notify 'wl-folder-open-all)))))
+ (wl-highlight-folder-path wl-folder-buffer-cur-path)
(set-buffer-modified-p nil)))
(defun wl-folder-close-all ()
(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)))
(defun wl-folder-open-close ()
"Open or close parent entity."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (wl-folder-buffer-group-p)
- ;; if group (whether opend or closed.)
- (wl-folder-jump-to-current-entity)
- ;; if folder
- (let (indent)
- (setq indent (save-excursion
- (re-search-forward "\\([ ]*\\)." nil t)
- (wl-match-buffer 1)))
- (while (looking-at indent)
- (forward-line -1)))
- (wl-folder-jump-to-current-entity))))
+ (unless (wl-folder-get-entity-from-buffer)
+ (error "No folder"))
+ (beginning-of-line)
+ (if (wl-folder-buffer-group-p)
+ ;; if group (whether opend or closed.)
+ (wl-folder-jump-to-current-entity)
+ ;; if folder
+ (let (indent)
+ (setq indent (save-excursion
+ (re-search-forward "\\([ ]*\\)." nil t)
+ (wl-match-buffer 1)))
+ (while (looking-at indent)
+ (forward-line -1)))
+ (wl-folder-jump-to-current-entity)))
(defsubst wl-folder-access-subscribe-p (group folder)
(let (subscr regexp match)
t)))
(defun wl-folder-update-access-group (entity new-flist)
- (let* ((flist (nth 2 entity))
- (unsubscribes (nth 3 entity))
- (len (+ (length flist) (length unsubscribes)))
- (i 0)
- diff new-unsubscribes removes
- subscribed-list folder group entry)
- ;; check subscribed groups
- (while flist
- (cond
- ((listp (car flist)) ;; group
- (setq group (elmo-string (caar flist)))
+ (let ((flist (nth 2 entity))
+ (unsubscribes (nth 3 entity))
+ diff new-unsubscribes removes
+ subscribed-list folder group entry)
+ (elmo-with-progress-display
+ (wl-folder-update-access-group (+ (length flist) (length unsubscribes)))
+ "Updating access group"
+ ;; check subscribed groups
+ (while flist
(cond
- ((assoc group new-flist) ;; found in new-flist
- (setq new-flist (delete (assoc group new-flist)
- new-flist))
- (if (wl-folder-access-subscribe-p (car entity) group)
- (wl-append subscribed-list (list (car flist)))
- (wl-append new-unsubscribes (list (car flist)))
- (setq diff t)))
- (t
- (setq wl-folder-group-alist
- (delete (wl-string-assoc group wl-folder-group-alist)
- wl-folder-group-alist))
- (wl-append removes (list (list group))))))
- (t ;; folder
- (setq folder (elmo-string (car flist)))
+ ((listp (car flist)) ;; group
+ (setq group (elmo-string (caar flist)))
+ (cond
+ ((assoc group new-flist) ;; found in new-flist
+ (setq new-flist (delete (assoc group new-flist)
+ new-flist))
+ (if (wl-folder-access-subscribe-p (car entity) group)
+ (wl-append subscribed-list (list (car flist)))
+ (wl-append new-unsubscribes (list (car flist)))
+ (setq diff t)))
+ (t
+ (setq wl-folder-group-alist
+ (delete (wl-string-assoc group wl-folder-group-alist)
+ wl-folder-group-alist))
+ (wl-append removes (list (list group))))))
+ (t ;; folder
+ (setq folder (elmo-string (car flist)))
+ (cond
+ ((member folder new-flist) ;; found in new-flist
+ (setq new-flist (delete folder new-flist))
+ (if (wl-folder-access-subscribe-p (car entity) folder)
+ (wl-append subscribed-list (list (car flist)))
+ (wl-append new-unsubscribes (list folder))
+ (setq diff t)))
+ (t
+ (wl-append removes (list folder))))))
+ (elmo-progress-notify 'wl-folder-update-access-group)
+ (setq flist (cdr flist)))
+ ;; check unsubscribed groups
+ (while unsubscribes
(cond
- ((member folder new-flist) ;; found in new-flist
- (setq new-flist (delete folder new-flist))
- (if (wl-folder-access-subscribe-p (car entity) folder)
- (wl-append subscribed-list (list (car flist)))
- (wl-append new-unsubscribes (list folder))
- (setq diff t)))
+ ((listp (car unsubscribes))
+ (when (setq entry (assoc (caar unsubscribes) new-flist))
+ (setq new-flist (delete entry new-flist))
+ (wl-append new-unsubscribes (list (car unsubscribes)))))
(t
- (wl-append removes (list folder))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'wl-folder-update-access-group "Updating access group..."
- (/ (* i 100) len))))
- (setq flist (cdr flist)))
- ;; check unsubscribed groups
- (while unsubscribes
- (cond
- ((listp (car unsubscribes))
- (when (setq entry (assoc (caar unsubscribes) new-flist))
- (setq new-flist (delete entry new-flist))
- (wl-append new-unsubscribes (list (car unsubscribes)))))
- (t
- (when (member (car unsubscribes) new-flist)
- (setq new-flist (delete (car unsubscribes) new-flist))
- (wl-append new-unsubscribes (list (car unsubscribes))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'wl-folder-update-access-group "Updating access group..."
- (/ (* i 100) len))))
- (setq unsubscribes (cdr unsubscribes)))
- ;;
- (if (or new-flist removes)
- (setq diff t))
- (setq new-flist
- (mapcar '(lambda (x)
- (cond ((consp x) (list (car x) 'access))
- (t x)))
- new-flist))
- ;; check new groups
- (let ((new-list new-flist))
- (while new-list
- (if (not (wl-folder-access-subscribe-p
- (car entity)
- (if (listp (car new-list))
- (caar new-list)
- (car new-list))))
- ;; auto unsubscribe
- (progn
- (wl-append new-unsubscribes (list (car new-list)))
- (setq new-flist (delete (car new-list) new-flist)))
- (cond
- ((listp (car new-list))
- ;; check group exists
- (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
- (progn
- (message "%s: group already exists." (caar new-list))
- (sit-for 1)
- (wl-append new-unsubscribes (list (car new-list)))
- (setq new-flist (delete (car new-list) new-flist)))
- (wl-append wl-folder-group-alist
- (list (cons (caar new-list) nil)))))))
- (setq new-list (cdr new-list))))
- (if new-flist
- (message "%d new folder(s)." (length new-flist))
- (message "Updating access group...done"))
+ (when (member (car unsubscribes) new-flist)
+ (setq new-flist (delete (car unsubscribes) new-flist))
+ (wl-append new-unsubscribes (list (car unsubscribes))))))
+ (elmo-progress-notify 'wl-folder-update-access-group)
+ (setq unsubscribes (cdr unsubscribes)))
+ ;;
+ (if (or new-flist removes)
+ (setq diff t))
+ (setq new-flist
+ (mapcar '(lambda (x)
+ (cond ((consp x) (list (car x) 'access))
+ (t x)))
+ new-flist))
+ ;; check new groups
+ (let ((new-list new-flist))
+ (while new-list
+ (if (not (wl-folder-access-subscribe-p
+ (car entity)
+ (if (listp (car new-list))
+ (caar new-list)
+ (car new-list))))
+ ;; auto unsubscribe
+ (progn
+ (wl-append new-unsubscribes (list (car new-list)))
+ (setq new-flist (delete (car new-list) new-flist)))
+ (cond
+ ((listp (car new-list))
+ ;; check group exists
+ (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
+ (progn
+ (message "%s: group already exists." (caar new-list))
+ (sit-for 1)
+ (wl-append new-unsubscribes (list (car new-list)))
+ (setq new-flist (delete (car new-list) new-flist)))
+ (wl-append wl-folder-group-alist
+ (list (cons (caar new-list) nil)))))))
+ (setq new-list (cdr new-list)))))
+ (when new-flist
+ (message "%d new folder(s)." (length new-flist)))
(wl-append new-flist subscribed-list) ;; new is first
(run-hooks 'wl-folder-update-access-group-hook)
(setcdr (cdr entity) (list new-flist new-unsubscribes))
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."
(kill-buffer bufname))))
(defun wl-folder-create-subr (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))))
+ (let ((name (elmo-folder-name-internal folder)))
+ (unless (elmo-folder-creatable-p folder)
+ (error "Folder %s does not exist" name))
+ (unless (y-or-n-p (format "Folder %s does not exist, create it? " name))
+ (error "Folder %s is not created" name))
+ (message "")
+ (setq wl-folder-entity-hashtb
+ (wl-folder-create-entity-hashtb name wl-folder-entity-hashtb))
+ (unless (elmo-folder-create folder)
+ (error "Create folder failed"))))
(defun wl-folder-confirm-existence (folder &optional force)
(if force
(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))))
(unless entity (error "No folder"))
(wl-folder-goto-folder-subr
(concat "/"
- (elmo-read-search-condition
+ (wl-read-search-condition
wl-fldmgr-make-filter-default)
"/" entity))))
(interactive)
(save-excursion
(let* ((condition (car (elmo-parse-search-condition
- (elmo-read-search-condition
+ (wl-read-search-condition
wl-summary-pick-field-default))))
(entity (wl-folder-get-entity-from-buffer))
(folder-list
(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) ":")))
+ (wl-search-condition-fields))))
+ (if (not flag)
+ (try-completion string candidate)
+ (all-completions string candidate))))))
+
(require 'product)
(product-provide (provide 'wl-folder) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff