(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)
(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)
(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)
(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)
(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
(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)
- (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)))
((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.
'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)))
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."
(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)
(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))))
(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)))
(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)
(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)
(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
(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
(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")
- elmo-msgdb-extra-fields))))
+ (wl-search-condition-fields))))
(if (not flag)
(try-completion string candidate)
(all-completions string candidate))))))
projects / elisp / wanderlust.git / blobdiff