X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-folder.el;h=9722be7383db4d81cd7170d42877846b4f44e783;hb=792117ed11a4e4977d87b2b10e5bee3bf99a154b;hp=63f4cb98c5f2048cce0b57512ed1833776d775a0;hpb=6386945bc4f3730552af80fafe45d8ea0b965254;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 63f4cb9..9722be7 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -1,4 +1,4 @@ -;;; wl-folder.el -- Folder mode for Wanderlust. +;;; wl-folder.el --- Folder mode for Wanderlust. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 1998,1999,2000 Masahiro MURATA @@ -46,6 +46,11 @@ (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 @@ -250,19 +255,14 @@ 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) @@ -290,7 +290,7 @@ (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 @@ -821,8 +821,12 @@ Optional argument ARG is repeart count." (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. @@ -832,7 +836,6 @@ Optional argument ARG is repeart count." (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 (or new (car nums)) @@ -842,8 +845,10 @@ Optional argument ARG is repeart count." (setq wl-folder-info-alist-modified t) (sit-for 0) (list (if wl-folder-notify-deleted - (car nums) - (or new (max (or (car nums) 0)))) unread (cdr nums)))) + (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) @@ -892,7 +897,7 @@ Optional argument ARG is repeart count." (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) )) @@ -1012,7 +1017,7 @@ If current line is group folder, check all subfolders." (let ((entity-name (wl-folder-get-entity-from-buffer)) (group (wl-folder-buffer-group-p))) (when (and entity-name - (y-or-n-p (format "Sync %s?" entity-name))) + (y-or-n-p (format "Sync %s? " entity-name))) (wl-folder-sync-entity (if group (wl-folder-search-group-entity-by-name entity-name @@ -1063,7 +1068,7 @@ If current line is group folder, all subfolders are marked." (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 @@ -1770,7 +1775,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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)) @@ -1996,7 +2001,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (interactive) (if wl-use-acap (wl-acap-init) - (funcall wl-folder-init-function))) + (funcall wl-folder-init-function)) + (run-hooks 'wl-folder-init-hook)) (defun wl-local-folder-init () "Initialize local folder." @@ -2029,23 +2035,11 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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-localdir-folder-dir-name-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. @@ -2053,17 +2047,18 @@ Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'." (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) @@ -2090,17 +2085,18 @@ Use `wl-subscribed-mailing-list'." (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) @@ -2207,7 +2203,7 @@ Use `wl-subscribed-mailing-list'." (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) @@ -2739,7 +2735,7 @@ If current line is group folder, all subfolders are prefetched." ; summary-buf entity) ; (when (and entity-name ; (y-or-n-p (format -; "Drop all unsync messages in %s?" entity-name))) +; "Drop all unsync messages in %s? " entity-name))) ; (setq entity ; (if group ; (wl-folder-search-group-entity-by-name entity-name @@ -2771,19 +2767,17 @@ Call `wl-summary-write-current-folder' with current folder name." (kill-buffer bufname)))) (defun wl-folder-create-subr (folder) - (if (not (elmo-folder-creatable-p folder)) - (error "Folder %s is not found" (elmo-folder-name-internal folder)) - (if (y-or-n-p - (format "Folder %s does not exist, create it?" - (elmo-folder-name-internal folder))) - (progn - (setq wl-folder-entity-hashtb - (wl-folder-create-entity-hashtb - (elmo-folder-name-internal folder) - wl-folder-entity-hashtb)) - (unless (elmo-folder-create folder) - (error "Create folder failed"))) - (error "Folder %s is not created" (elmo-folder-name-internal folder))))) + (if (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)))) (defun wl-folder-confirm-existence (folder &optional force) (if force