X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=1385b0ccb269122ab74f8f680ae7215b077007b5;hb=63dc9460bc7e5e46ace0b223a97da943b6405ac4;hp=2a166316b252453d011a6caec7f85df94e6d530e;hpb=3aae466ce7cb0bc46f270ef38735e8bb3dfbadf2;p=elisp%2Fwanderlust.git diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 2a16631..1385b0c 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -187,7 +187,7 @@ (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-folder-save-and-exec-marks) + (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) @@ -248,11 +248,17 @@ (defun wl-folder-buffer-search-entity (folder &optional searchname) (let ((search (or searchname (wl-folder-get-petname folder))) - case-fold-search) - (re-search-forward - (concat - "^[ \t]*" - (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+") nil t))) + 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) @@ -330,22 +336,30 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (string= (elmo-folder-name-internal wl-draft-folder-internal) wl-draft-folder)) wl-draft-folder-internal - (setq wl-draft-folder-internal (elmo-make-folder wl-draft-folder)) + (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)) -(defmacro wl-folder-get-elmo-folder (entity &optional no-cache) +(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." - `(if ,no-cache - (elmo-make-folder (elmo-string ,entity)) - (if (string= (elmo-string ,entity) wl-draft-folder) - (wl-draft-get-folder) - (or (wl-folder-elmo-folder-cache-get ,entity) - (let* ((name (elmo-string ,entity)) - (folder (elmo-make-folder name))) - (wl-folder-elmo-folder-cache-put name folder) - folder))))) + (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) @@ -505,6 +519,18 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'." (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) @@ -561,7 +587,7 @@ Optional argument ARG is repeart count." (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 @@ -839,19 +865,16 @@ Optional argument ARG is repeart count." (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)) @@ -866,9 +889,11 @@ Optional argument ARG is repeart count." (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) - (nth 1 (elmo-folder-count-flags 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))) @@ -1016,36 +1041,32 @@ If current line is group folder, check all sub entries." ((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. @@ -1073,39 +1094,34 @@ If current line is group folder, check all subfolders." (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. @@ -1326,7 +1342,8 @@ If current line is group folder, all subfolders are marked." '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))) @@ -1341,8 +1358,8 @@ If current line is group folder, all subfolders are marked." 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)))))) @@ -1387,8 +1404,9 @@ If current line is group folder, all subfolders are marked." ;; 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 @@ -1404,9 +1422,11 @@ If current line is group folder, all subfolders are marked." (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." @@ -1491,15 +1511,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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 () (let (initialize folder-buf) @@ -1577,8 +1594,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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)))) @@ -2044,7 +2061,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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)) @@ -2052,8 +2070,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'." (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))) @@ -2288,10 +2306,6 @@ Use `wl-subscribed-mailing-list'." (wl-folder-get-elmo-folder fld-name)) nil sticky t))) -(defun wl-folder-save-and-exec-marks () - (interactive) - (wl-save 'exec-marks)) - (defun wl-folder-suspend () (interactive) (run-hooks 'wl-folder-suspend-hook) @@ -2457,12 +2471,13 @@ Use `wl-subscribed-mailing-list'." (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) @@ -2870,19 +2885,16 @@ Call `wl-summary-write-current-folder' with current folder name." (kill-buffer bufname)))) (defun wl-folder-create-subr (folder) - (if (elmo-folder-creatable-p folder) - (if (y-or-n-p (format "Folder %s does not exist, create it? " - (elmo-folder-name-internal folder))) - (progn - (message "") - (setq wl-folder-entity-hashtb - (wl-folder-create-entity-hashtb - (elmo-folder-name-internal folder) - wl-folder-entity-hashtb)) - (unless (elmo-folder-create folder) - (error "Create folder failed"))) - (error "Folder %s is not created" (elmo-folder-name-internal folder))) - (error "Folder %s does not exist" (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 @@ -2910,7 +2922,7 @@ Call `wl-summary-write-current-folder' with current folder name." (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)))) @@ -2918,7 +2930,7 @@ Call `wl-summary-write-current-folder' with current folder name." (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 @@ -3005,7 +3017,7 @@ Call `wl-summary-write-current-folder' with current folder name." (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 @@ -3020,10 +3032,7 @@ Call `wl-summary-write-current-folder' with current folder name." (t (let ((candidate (mapcar (lambda (x) (list (concat (downcase x) ":"))) - (append '("last" "first" - "from" "subject" "to" "cc" "body" - "since" "before" "tocc") - elmo-msgdb-extra-fields)))) + (wl-search-condition-fields)))) (if (not flag) (try-completion string candidate) (all-completions string candidate))))))