(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\\*-]+$")
["Next Folder" wl-folder-next-entity t]
["Check Current Folder" wl-folder-check-current-entity t]
["Sync Current Folder" wl-folder-sync-current-entity t]
-; ["Drop Current Folder" wl-folder-drop-unsync-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]
nil
(setq wl-folder-mode-map (make-sparse-keymap))
(define-key wl-folder-mode-map " " 'wl-folder-jump-to-current-entity)
-; (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close)
+;;; (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 "rs" 'wl-folder-check-region)
(define-key wl-folder-mode-map "s" 'wl-folder-check-current-entity)
(define-key wl-folder-mode-map "I" 'wl-folder-prefetch-current-entity)
-; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
+;;; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
(define-key wl-folder-mode-map "p" 'wl-folder-prev-entity)
(define-key wl-folder-mode-map "n" 'wl-folder-next-entity)
(define-key wl-folder-mode-map "v" 'wl-folder-toggle-disp-summary)
"Menu used in Folder mode."
wl-folder-mode-menu-spec))
-(defmacro wl-folder-unread-regex (group)
- (` (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
- (if (, group)
- "\\|^[ ]*\\[[+-]\\]"
- ""))))
+(defun wl-folder-unread-regex (group)
+ (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
+ (if group
+ "\\|^[ ]*\\[[+-]\\]"
+ "")))
-(defmacro wl-folder-buffer-group-p ()
- (` (get-text-property (point) 'wl-folder-is-group)))
+(defun wl-folder-buffer-group-p ()
+ (get-text-property (point) 'wl-folder-is-group))
(defun wl-folder-buffer-search-group (group)
(let ((prev-point (point))
(defmacro wl-folder-get-entity-id (entity)
`(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 ,getid
- id
- (wl-folder-get-folder-name-by-id id))))
+(defun wl-folder-get-entity-from-buffer (&optional getid)
+ (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)
- (or (, hashtb) wl-folder-entity-hashtb))))
- (and sym (boundp sym)))))
+ `(let ((sym (intern-soft ,entity (or ,hashtb wl-folder-entity-hashtb))))
+ (and sym (boundp sym))))
(defmacro wl-folder-clear-entity-info (entity &optional hashtb)
- (` (elmo-clear-hash-val (, entity) (or (, hashtb) wl-folder-entity-hashtb))))
+ `(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))))
+ `(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 (elmo-string (, entity))
- (if (< (length (, value)) 4)
- (append (, value) (list (nth 3 info)))
- (, value))
- hashtb))))
+ `(let* ((hashtb (or ,hashtb wl-folder-entity-hashtb))
+ (info (wl-folder-get-entity-info ,entity hashtb)))
+ (elmo-set-hash-val (elmo-string ,entity)
+ (if (< (length ,value) 4)
+ (append ,value (list (nth 3 info)))
+ ,value)
+ hashtb)))
(defun wl-folder-persistent-p (folder)
(or (and (wl-folder-search-entity-by-name folder wl-folder-entity
(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-get-hash-val (, name)
- (or (, hashtb) wl-folder-elmo-folder-hashtb))))
+ `(elmo-get-hash-val ,name
+ (or ,hashtb wl-folder-elmo-folder-hashtb)))
(defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb)
"Get folder elmo folder structure on HASHTB for folder with NAME.
Default HASHTB is `wl-folder-elmo-folder-hashtb'."
- (` (elmo-set-hash-val (, name) (, folder)
- (or (, hashtb) 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."
(setq entity (wl-pop entities))
(cond
((consp entity)
-;; (if (and (string= name (car entity))
-;; (eq id (wl-folder-get-entity-id (car entity))))
-;; (throw 'done last-entity))
+;;; (if (and (string= name (car entity))
+;;; (eq id (wl-folder-get-entity-id (car entity))))
+;;; (throw 'done last-entity))
(and entities
(wl-push entities entity-stack))
(setq entities (nth 2 entity)))
(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 (and buffer
- (with-current-buffer buffer
- (string= wl-summary-buffer-folder-name folder)))
+ (if buffer
(with-current-buffer buffer
(wl-summary-set-persistent-mark flag number))
;; Parent buffer does not exist.
(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)))
+;;; (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)
(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)
+;;; (wl-delete-all-overlays)
+;;; (wl-highlight-folder-current-line)
))
;; ordinal folder
(wl-folder-set-current-entity-id
ret-val
(wl-folder-check-entity (car flist))))
(setq flist (cdr flist)))
- ;(wl-folder-buffer-search-entity (car entity))
- ;(wl-folder-update-line ret-val)
+;;; (wl-folder-buffer-search-entity (car entity))
+;;; (wl-folder-update-line ret-val)
))
((stringp entity)
(message "Checking \"%s\"" entity)
(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 (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)))
+ (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)
- (or (cdr (assq 'unread
- (elmo-folder-count-flags folder))) 0)))
+ (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)))
ret-val
(wl-folder-check-one-entity (elmo-folder-name-internal
folder))))
- ;;(sit-for 0)
+;;; (sit-for 0)
))
;; check network entity at last
(when async-folder-list
ret-val
(wl-folder-check-one-entity (elmo-folder-name-internal
folder))))
- ;;(sit-for 0)
+;;; (sit-for 0)
)))
ret-val))
((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 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
- (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
- (save-excursion
- (wl-summary-goto-folder-subr entity
- (wl-summary-get-sync-range
- folder)
- nil nil nil t)
- (if sticky
- (wl-summary-save-status)
- (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 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
- (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)
- (if sticky
- (wl-summary-save-status)
- (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.
(let (name)
(setq name (wl-match-buffer 1))
(goto-char (+ 1 (match-end 0)))
-; (condition-case ()
-; (unwind-protect
-; (setq flist (elmo-list-folders name)))
-; (error (message "Access to folder %s failed." name)))
-;; (setq flist (elmo-msgdb-flist-load name)) ; load flist.
-;; (setq unsublist (nth 1 flist))
-;; (setq flist (car flist))
-;; (list name 'access flist unsublist)))
+;;; (condition-case ()
+;;; (unwind-protect
+;;; (setq flist (elmo-list-folders name)))
+;;; (error (message "Access to folder %s failed." name)))
+;;; (setq flist (elmo-msgdb-flist-load name)) ; load flist.
+;;; (setq unsublist (nth 1 flist))
+;;; (setq flist (car flist))
+;;; (list name 'access flist unsublist)))
(append (list name 'access) (wl-create-access-folder-entity name))))
- ;((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
+;;; ((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
((looking-at "^[\t ]*=[ \t]+\\([^\n]+\\)$"); petname definition
(goto-char (+ 1 (match-end 0)))
(let ((rest (elmo-match-buffer 1))
;; 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."
(list new unread all)))
(defsubst wl-folder-make-save-access-list (list)
- (mapcar '(lambda (x)
- (cond
- ((consp x)
- (list (elmo-string (car x)) 'access))
- (t
- (elmo-string x))))
+ (mapcar (lambda (x)
+ (cond
+ ((consp x)
+ (list (elmo-string (car x)) 'access))
+ (t
+ (elmo-string x))))
list))
(defun wl-folder-update-newest (indent entity)
(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)))
- (setq flist (cdr flist)))
- (if (> len 0)
- (message "Inserting group %s...done" (car entity))))
+ (elmo-progress-notify 'wl-folder-insert-entity)
+ (setq flist (cdr flist))))
(save-excursion
(goto-char group-name-end)
(delete-region (point) (save-excursion (end-of-line)
hashtb))
;; Unsync number is reserved.
-;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
-;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
-;; (entities (list entity))
-;; entity-stack)
-;; (while entities
-;; (setq entity (wl-pop entities))
-;; (cond
-;; ((consp entity)
-;; (if id-name
-;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
-;; (car entity)))
-;; (and entities
-;; (wl-push entities entity-stack))
-;; (setq entities (nth 2 entity))
-;; )
-;; ((stringp entity)
-;; (wl-folder-set-entity-info entity
-;; (wl-folder-get-entity-info entity)
-;; hashtb)
-;; (if id-name
-;; (wl-folder-set-id-name (wl-folder-get-entity-id entity)
-;; entity))))
-;; (unless entities
-;; (setq entities (wl-pop entity-stack))))
-;; hashtb))
+;;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
+;;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
+;;; (entities (list entity))
+;;; entity-stack)
+;;; (while entities
+;;; (setq entity (wl-pop entities))
+;;; (cond
+;;; ((consp entity)
+;;; (if id-name
+;;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
+;;; (car entity)))
+;;; (and entities
+;;; (wl-push entities entity-stack))
+;;; (setq entities (nth 2 entity))
+;;; )
+;;; ((stringp entity)
+;;; (wl-folder-set-entity-info entity
+;;; (wl-folder-get-entity-info entity)
+;;; hashtb)
+;;; (if id-name
+;;; (wl-folder-set-id-name (wl-folder-get-entity-id entity)
+;;; entity))))
+;;; (unless entities
+;;; (setq entities (wl-pop entity-stack))))
+;;; hashtb))
(defun wl-folder-create-newsgroups-from-nntp-access (entity)
(let ((flist (nth 2 entity))
(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)))
(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 cur-new (string-to-number
(wl-match-buffer 2)))
- (setq cur-unread (string-to-int
+ (setq cur-unread (string-to-number
(wl-match-buffer 3)))
- (setq cur-all (string-to-int
+ (setq cur-all (string-to-number
(wl-match-buffer 4)))
(delete-region (match-beginning 2)
(match-end 4))
(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-]+$"
- 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))))
- (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))))
+ (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)
- (message "Opening all folders...done")
(set-buffer-modified-p nil)))
(defun wl-folder-close-all ()
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-folder-check-entity entity))
(wl-folder-prefetch-entity entity)))))
-;(defun wl-folder-drop-unsync-entity (entity)
-; "Drop all unsync messages in the ENTITY."
-; (cond
-; ((consp entity)
-; (let ((flist (nth 2 entity)))
-; (while flist
-; (wl-folder-drop-unsync-entity (car flist))
-; (setq flist (cdr flist)))))
-; ((stringp entity)
-; (let ((nums (wl-folder-get-entity-info entity))
-; wl-summary-highlight wl-auto-select-first new)
-; (setq new (or (car nums) 0))
-; (if (< 0 new)
-; (save-window-excursion
-; (save-excursion
-; (let ((wl-summary-buffer-name (concat
-; wl-summary-buffer-name
-; (symbol-name this-command))))
-; (wl-summary-goto-folder-subr entity 'no-sync nil)
-; (wl-summary-drop-unsync)
-; (wl-summary-exit)))))))))
-
-;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
-; "Drop all unsync messages in the folder at position.
-;If current line is group folder, all subfolders are dropped.
-;If optional arg exists, don't check any folders."
-; (interactive "P")
-; (save-excursion
-; (let ((entity-name (wl-folder-get-entity-from-buffer))
-; (group (wl-folder-buffer-group-p))
-; wl-folder-check-entity-hook
-; summary-buf entity)
-; (when (and entity-name
-; (y-or-n-p (format
-; "Drop all unsync messages in %s? " entity-name)))
-; (setq entity
-; (if group
-; (wl-folder-search-group-entity-by-name entity-name
-; wl-folder-entity)
-; entity-name))
-; (if (null force-check)
-; (wl-folder-check-entity entity))
-; (wl-folder-drop-unsync-entity entity)
-; (message "All unsync messages in %s are dropped!" entity-name)))))
+;;;(defun wl-folder-drop-unsync-entity (entity)
+;;; "Drop all unsync messages in the ENTITY."
+;;; (cond
+;;; ((consp entity)
+;;; (let ((flist (nth 2 entity)))
+;;; (while flist
+;;; (wl-folder-drop-unsync-entity (car flist))
+;;; (setq flist (cdr flist)))))
+;;; ((stringp entity)
+;;; (let ((nums (wl-folder-get-entity-info entity))
+;;; wl-summary-highlight wl-auto-select-first new)
+;;; (setq new (or (car nums) 0))
+;;; (if (< 0 new)
+;;; (save-window-excursion
+;;; (save-excursion
+;;; (let ((wl-summary-buffer-name (concat
+;;; wl-summary-buffer-name
+;;; (symbol-name this-command))))
+;;; (wl-summary-goto-folder-subr entity 'no-sync nil)
+;;; (wl-summary-drop-unsync)
+;;; (wl-summary-exit)))))))))
+
+;;;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
+;;; "Drop all unsync messages in the folder at position.
+;;;If current line is group folder, all subfolders are dropped.
+;;;If optional arg exists, don't check any folders."
+;;; (interactive "P")
+;;; (save-excursion
+;;; (let ((entity-name (wl-folder-get-entity-from-buffer))
+;;; (group (wl-folder-buffer-group-p))
+;;; wl-folder-check-entity-hook
+;;; summary-buf entity)
+;;; (when (and entity-name
+;;; (y-or-n-p (format
+;;; "Drop all unsync messages in %s? " entity-name)))
+;;; (setq entity
+;;; (if group
+;;; (wl-folder-search-group-entity-by-name entity-name
+;;; wl-folder-entity)
+;;; entity-name))
+;;; (if (null force-check)
+;;; (wl-folder-check-entity entity))
+;;; (wl-folder-drop-unsync-entity entity)
+;;; (message "All unsync messages in %s are dropped!" entity-name)))))
(defun wl-folder-write-current-folder ()
"Write message to current folder's newsgroup or mailing-list.
(setq folder-list (cdr folder-list)))
(if results
(message "%s are picked."
- (mapconcat '(lambda (res)
- (format "%s(%d)"
- (car res)
- (length (cdr res))))
+ (mapconcat (lambda (res)
+ (format "%s(%d)"
+ (car res)
+ (length (cdr res))))
results
","))
(message "No message was picked.")))))
(defun wl-folder-complete-filter-condition (string predicate flag)
(cond
- ((string-match "^\\(.*|\\|.*&\\|.*!\\|.*(\\)\\([^:]*\\)$" string)
+ ((string-match "^\\(.*|\\|.*&\\|.*(\\)\\([^:]*\\)$" string)
(let* ((str1 (match-string 1 string))
(str2 (match-string 2 string))
(str2-comp
(t
(let ((candidate
(mapcar (lambda (x) (list (concat (downcase x) ":")))
- (append '("last" "first"
- "from" "subject" "to" "cc" "body"
- "since" "before" "tocc"
- "larger" "smaller")
- elmo-msgdb-extra-fields))))
+ (wl-search-condition-fields))))
(if (not flag)
(try-completion string candidate)
(all-completions string candidate))))))
projects / elisp / wanderlust.git / blobdiff