-;;; wl-folder.el -- Folder mode for Wanderlust.
+;;; wl-folder.el --- Folder mode for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
(require 'wl)
(require 'elmo-nntp))
+(defcustom wl-folder-init-hook nil
+ "A hook called after folder initialization is finished."
+ :type 'hook
+ :group 'wl)
+
(defvar wl-folder-buffer-name "Folder")
(defvar wl-folder-entity nil) ; desktop entity.
(defvar wl-folder-group-alist nil) ; opened or closed
entity (or hashtb wl-folder-entity-id-name-hashtb))))
(defmacro wl-folder-get-entity-id (entity)
- (` (or (get-text-property 0
- 'wl-folder-entity-id
- (, entity))
- (, entity)))) ;; for nemacs
+ `(get-text-property 0 'wl-folder-entity-id ,entity))
(defmacro wl-folder-get-entity-from-buffer (&optional getid)
- (` (let ((id (get-text-property (point)
- 'wl-folder-entity-id)))
- (if (not id) ;; for nemacs
- (wl-folder-get-realname (wl-folder-folder-name))
- (if (, getid)
- id
- (wl-folder-get-folder-name-by-id id))))))
+ `(let ((id (get-text-property (point)
+ 'wl-folder-entity-id)))
+ (if ,getid
+ id
+ (wl-folder-get-folder-name-by-id id))))
(defmacro wl-folder-entity-exists-p (entity &optional hashtb)
(` (let ((sym (intern-soft (, entity)
(defun wl-folder-persistent-p (folder)
(or (and (wl-folder-search-entity-by-name folder wl-folder-entity
'folder)
- t) ; on Folder mode.
+ t) ; on Folder mode.
(catch 'found
(let ((li wl-save-folder-list))
(while li
(not (elmo-folder-exists-p folder)))
(wl-folder-create-subr folder)
(signal (car err) (cdr err))))))
+ (new (elmo-diff-new nums))
+ (nums (cons (elmo-diff-unread nums) (elmo-diff-all nums)))
unread unsync nomif)
(if (and (eq wl-folder-notify-deleted 'sync)
(car nums)
(wl-folder-sync-entity entity)
(setq nums (elmo-folder-diff folder)))
(unless wl-folder-notify-deleted
- (setq unsync (if (and (car nums) (> 0 (car nums))) 0 (car nums)))
- (setq nomif (if (and (car nums) (> 0 (cdr nums))) 0 (cdr nums)))
+ (setq unsync (if (car nums)
+ (max 0 (car nums))
+ nil))
+ (setq nomif (if (cdr nums)
+ (max 0 (cdr nums))
+ nil))
(setq nums (cons unsync nomif)))
(setq unread (or ;; If server diff, All unreads are
; treated as unsync.
(if (elmo-folder-use-flag-p folder)
- 0)
+ (car nums))
(elmo-folder-get-info-unread folder)
(wl-summary-count-unread (elmo-msgdb-mark-load
(elmo-folder-msgdb-path
folder)))))
- (setq unread (min unread (- (or (cdr nums) 0) (or (car nums) 0))))
+ (when new (setq unread (- unread new)))
(wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
- (list (car nums)
+ (list (or new (car nums))
unread
(cdr nums))
(get-buffer wl-folder-buffer-name)))
(setq wl-folder-info-alist-modified t)
(sit-for 0)
(list (if wl-folder-notify-deleted
- (car nums)
- (max (or (car nums) 0))) unread (cdr nums))))
+ (or new (car nums) 0)
+ (max 0 (or new (car nums) 0)))
+ unread
+ (cdr nums))))
(defun wl-folder-check-entity-async (entity &optional auto)
(let ((elmo-nntp-groups-async t)
(setq ret-val
(wl-folder-add-folder-info
ret-val
- (wl-folder-check-one-entity (elmo-folder-name-internal
+ (wl-folder-check-one-entity (elmo-folder-name-internal
folder))))
;;(sit-for 0)
))
(switch-to-buffer (get-buffer-create wl-folder-buffer-name)))
(set-buffer wl-folder-buffer-name)
(wl-folder-mode)
- (wl-folder-init)
+ ;; Initialization.
+ (setq wl-folder-entity-id 0)
+ (wl-folder-entity-assign-id wl-folder-entity)
+ (setq wl-folder-entity-hashtb
+ (wl-folder-create-entity-hashtb wl-folder-entity))
+ (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id))
+ (setq wl-folder-group-alist
+ (wl-folder-create-group-alist wl-folder-entity))
+ (setq wl-folder-newsgroups-hashtb
+ (wl-folder-create-newsgroups-hashtb wl-folder-entity))
+ (wl-folder-init-info-hashtb)
(let ((inhibit-read-only t)
(buffer-read-only nil))
(erase-buffer)
(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))
(defvar wl-folder-init-function 'wl-local-folder-init)
(defun wl-folder-init ()
- "Call `wl-folder-init-function' function."
+ "Return top-level folder entity."
(interactive)
- (funcall wl-folder-init-function))
+ (if wl-use-acap
+ (wl-acap-init)
+ (funcall wl-folder-init-function))
+ (run-hooks 'wl-folder-init-hook))
(defun wl-local-folder-init ()
"Initialize local folder."
(message "Initializing folder...")
- (save-excursion
- (set-buffer wl-folder-buffer-name)
- (let ((entity (wl-folder-create-folder-entity))
- (inhibit-read-only t))
- (setq wl-folder-entity entity)
- (setq wl-folder-entity-id 0)
- (wl-folder-entity-assign-id wl-folder-entity)
- (setq wl-folder-entity-hashtb
- (wl-folder-create-entity-hashtb entity))
- (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id))
- (setq wl-folder-group-alist
- (wl-folder-create-group-alist entity))
- (setq wl-folder-newsgroups-hashtb
- (wl-folder-create-newsgroups-hashtb wl-folder-entity))
- (wl-folder-init-info-hashtb)))
+ (setq wl-folder-entity (wl-folder-create-folder-entity))
(message "Initializing folder...done"))
(defun wl-folder-get-realname (petname)
(defun wl-folder-get-newsgroups (folder)
"Return Newsgroups field value string for FOLDER newsgroup.
If FOLDER is multi, return comma separated string (cross post)."
- (let ((flist (elmo-folder-get-primitive-list
- (wl-folder-get-elmo-folder folder))) ; multi
- newsgroups fld ret)
- (while (setq fld (car flist))
- (if (setq ret
- (cond ((eq 'nntp (elmo-folder-type-internal fld))
- (elmo-nntp-folder-group-internal fld))
- ((eq 'localnews (elmo-folder-type-internal fld))
- (elmo-replace-in-string
- (elmo-nntp-folder-group-internal fld)
- "/" "\\."))))
- ;; append newsgroup
- (setq newsgroups (if (stringp newsgroups)
- (concat newsgroups "," ret)
- ret)))
- (setq flist (cdr flist)))
- (list nil nil newsgroups)))
+ (let ((nlist (elmo-folder-newsgroups
+ (wl-folder-get-elmo-folder folder))))
+ (if nlist
+ (list nil nil (mapconcat 'identity nlist ","))
+ nil)))
(defun wl-folder-guess-mailing-list-by-refile-rule (entity)
"Return ML address guess by FOLDER.
(let ((flist
(elmo-folder-get-primitive-list
(wl-folder-get-elmo-folder entity)))
- fld ret mlist)
+ fld mladdr to)
(while (setq fld (car flist))
- (if (setq ret
- (wl-folder-guess-mailing-list-by-refile-rule-subr
- (elmo-folder-name-internal fld)))
- (setq mlist (if (stringp mlist)
- (concat mlist ", " ret)
- ret)))
+ (setq mladdr (wl-folder-guess-mailing-list-by-refile-rule-subr
+ (elmo-folder-name-internal fld)))
+ (when mladdr
+ (setq to (if (stringp to)
+ (concat to ", " mladdr)
+ mladdr)))
(setq flist (cdr flist)))
- (if mlist
- (list mlist nil nil))))
+ (if (stringp to)
+ (list to nil nil)
+ nil)))
(defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity)
(unless (memq (elmo-folder-type entity)
(let ((flist
(elmo-folder-get-primitive-list
(wl-folder-get-elmo-folder entity)))
- fld ret mlist)
+ fld mladdr to)
(while (setq fld (car flist))
- (if (setq ret
- (wl-folder-guess-mailing-list-by-folder-name-subr
- (elmo-folder-name-internal fld)))
- (setq mlist (if (stringp mlist)
- (concat mlist ", " ret)
- ret)))
+ (setq mladdr (wl-folder-guess-mailing-list-by-folder-name-subr
+ (elmo-folder-name-internal fld)))
+ (when mladdr
+ (setq to (if (stringp to)
+ (concat to ", " mladdr)
+ mladdr)))
(setq flist (cdr flist)))
- (if mlist
- (list mlist nil nil))))
+ (if (stringp to)
+ (list to nil nil)
+ nil)))
(defun wl-folder-guess-mailing-list-by-folder-name-subr (entity)
(when (memq (elmo-folder-type entity)
(wl-summary-get-sync-range
(wl-folder-get-elmo-folder fld-name))
nil sticky t)))
-
+
(defun wl-folder-suspend ()
(interactive)
(run-hooks 'wl-folder-suspend-hook)
projects / elisp / wanderlust.git / blobdiff