(defvar wl-folder-buffer-disp-summary nil)
(defvar wl-folder-buffer-cur-entity-id nil)
+(defvar wl-folder-buffer-last-visited-entity-id nil)
(defvar wl-folder-buffer-cur-path nil)
(defvar wl-folder-buffer-cur-point nil)
(make-variable-buffer-local 'wl-folder-buffer-disp-summary)
(make-variable-buffer-local 'wl-folder-buffer-cur-entity-id)
+(make-variable-buffer-local 'wl-folder-buffer-last-visited-entity-id)
(make-variable-buffer-local 'wl-folder-buffer-cur-path)
(make-variable-buffer-local 'wl-folder-buffer-cur-point)
(define-key wl-folder-mode-map "g" 'wl-folder-goto-folder)
(define-key wl-folder-mode-map "G" 'wl-folder-goto-folder-sticky)
(define-key wl-folder-mode-map "j" 'wl-folder-jump-to-current-entity)
+ (define-key wl-folder-mode-map "\C-i" 'wl-folder-revisit-last-visited-folder)
(define-key wl-folder-mode-map "w" 'wl-draft)
(define-key wl-folder-mode-map "W" 'wl-folder-write-current-folder)
(define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
(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-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)
(and sym (boundp sym)))))
(defmacro wl-folder-clear-entity-info (entity &optional hashtb)
- (` (let ((sym (intern-soft (, entity)
- (or (, hashtb) wl-folder-entity-hashtb))))
- (if (boundp sym)
- (makunbound sym)))))
+ (` (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))))
(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 (and buffer
+ (with-current-buffer buffer
+ (string= wl-summary-buffer-folder-name folder)))
+ (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
(defun wl-folder-jump-to-current-entity (&optional arg)
"Enter the current folder. If optional ARG exists, update folder list."
(interactive "P")
- (beginning-of-line)
- (let (entity beg end indent opened fname err fld-name)
- (cond
- ((and (wl-folder-buffer-group-p)
- (looking-at wl-folder-group-regexp))
- (save-excursion
- (setq fname (wl-folder-get-entity-from-buffer))
- (setq indent (wl-match-buffer 1))
- (setq opened (wl-match-buffer 2))
- (if (string= opened "+")
- (progn
- (setq entity (wl-folder-search-group-entity-by-name
- fname
- wl-folder-entity))
- (setq beg (point))
- (if arg
- (wl-folder-update-recursive-current-entity entity)
- ;; insert as opened
- (setcdr (assoc (car entity) wl-folder-group-alist) t)
- (if (eq 'access (cadr entity))
- (wl-folder-maybe-load-folder-list entity))
- ;(condition-case errobj
- (progn
- (if (or (wl-folder-force-fetch-p (car entity))
- (and
- (eq 'access (cadr entity))
- (null (caddr entity))))
- (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 fname wl-folder-group-alist) nil))
- ; (error
- ; (elmo-display-error errobj t)
- ; (ding)
- ; (setq err t)
- ; (setcdr (assoc fname wl-folder-group-alist) nil)))
- (if (not err)
- (let ((buffer-read-only nil))
- (delete-region (save-excursion (beginning-of-line)
- (point))
- (save-excursion (end-of-line)
- (+ 1 (point))))))))
- (setq beg (point))
- (end-of-line)
- (save-match-data
- (setq end
- (progn (wl-folder-goto-bottom-of-current-folder indent)
- (beginning-of-line)
- (point))))
- (setq entity (wl-folder-search-group-entity-by-name
- fname
- wl-folder-entity))
- (let ((buffer-read-only nil))
- (delete-region beg end))
- (setcdr (assoc (car entity) wl-folder-group-alist) nil)
- (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)
- )))
- ((setq fld-name (wl-folder-get-entity-from-buffer))
+ (let ((fld-name (wl-folder-get-entity-from-buffer))
+ entity beg end indent opened err)
+ (unless fld-name
+ (error "No folder"))
+ (beginning-of-line)
+ (if (and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp))
+ ;; folder group
+ (save-excursion
+ (setq indent (wl-match-buffer 1))
+ (setq opened (wl-match-buffer 2))
+ (if (string= opened "+")
+ (progn
+ (setq entity (wl-folder-search-group-entity-by-name
+ fld-name
+ wl-folder-entity))
+ (setq beg (point))
+ (if arg
+ (wl-folder-update-recursive-current-entity entity)
+ ;; insert as opened
+ (setcdr (assoc (car entity) wl-folder-group-alist) t)
+ (if (eq 'access (cadr entity))
+ (wl-folder-maybe-load-folder-list entity))
+ ;(condition-case errobj
+ (progn
+ (if (or (wl-folder-force-fetch-p (car entity))
+ (and
+ (eq 'access (cadr entity))
+ (null (caddr entity))))
+ (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)))
+ (if (not err)
+ (let ((buffer-read-only nil))
+ (delete-region (save-excursion (beginning-of-line)
+ (point))
+ (save-excursion (end-of-line)
+ (+ 1 (point))))))))
+ (setq beg (point))
+ (end-of-line)
+ (save-match-data
+ (setq end
+ (progn (wl-folder-goto-bottom-of-current-folder indent)
+ (beginning-of-line)
+ (point))))
+ (setq entity (wl-folder-search-group-entity-by-name
+ fld-name
+ wl-folder-entity))
+ (let ((buffer-read-only nil))
+ (delete-region beg end))
+ (setcdr (assoc (car entity) wl-folder-group-alist) nil)
+ (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)
+ ))
+ ;; ordinal folder
(wl-folder-set-current-entity-id
(get-text-property (point) 'wl-folder-entity-id))
(setq fld-name (wl-folder-get-folder-name-by-id
(wl-summary-goto-folder-subr fld-name
(wl-summary-get-sync-range
(wl-folder-get-elmo-folder fld-name))
- nil arg t)))))
+ nil arg t))))
(set-buffer-modified-p nil))
(defun wl-folder-close-entity (entity)
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))))
+ (or (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)))
(if buf-win
(select-window buf-win)
(set-buffer buf))
+ (when (and wl-folder-buffer-cur-entity-id
+ (not (eq wl-folder-buffer-cur-entity-id entity-id)))
+ (setq wl-folder-buffer-last-visited-entity-id wl-folder-buffer-cur-entity-id))
(setq wl-folder-buffer-cur-entity-id entity-id)
(setq wl-folder-buffer-cur-path
(wl-folder-get-path wl-folder-entity entity-id))
'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))))))
(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 (&optional arg)
- (interactive "P")
+(defun wl-folder ()
(let (initialize folder-buf)
(if (setq folder-buf (get-buffer wl-folder-buffer-name))
(if wl-folder-use-frame
(set-buffer wl-folder-buffer-name)
(wl-folder-mode)
;; Initialization.
+ (unless wl-folder-entity
+ (wl-folder-init))
(setq wl-folder-entity-id 0)
(wl-folder-entity-assign-id wl-folder-entity)
(setq wl-folder-entity-hashtb
(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))))
(wl-folder-check-entity wl-folder-entity))
(defun wl-folder-entity-hashtb-set (entity-hashtb name value buffer)
- (let (cur-val
+ (let ((cur-val (wl-folder-get-entity-info name entity-hashtb))
(new-diff 0)
(unread-diff 0)
(all-diff 0)
- diffs
- entity-list)
- (setq cur-val (wl-folder-get-entity-info name entity-hashtb))
+ diffs)
(setq new-diff (- (or (nth 0 value) 0) (or (nth 0 cur-val) 0)))
(setq unread-diff
(+ new-diff
(save-match-data
(with-current-buffer buffer
(save-excursion
- (setq entity-list (wl-folder-search-entity-list-by-name
- name wl-folder-entity))
- (while entity-list
- (wl-folder-update-group (car entity-list) diffs)
- (setq entity-list (cdr entity-list)))
+ (let ((entity-list (wl-folder-search-entity-list-by-name
+ name wl-folder-entity)))
+ (while entity-list
+ (wl-folder-update-group (car entity-list) diffs)
+ (setq entity-list (cdr entity-list))))
(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))
- cur-unread
- (unread-diff 0)
- ;;(fld (elmo-string folder))
- value newvalue entity-list)
+ (let ((buf (get-buffer wl-folder-buffer-name))
+ (value (wl-folder-get-entity-info folder))
+ cur-unread
+ (unread-diff 0)
+ newvalue)
;;; Update folder-info
;;; (elmo-folder-set-info-hashtb fld nil nil nil unread)
- (setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0))
- (setq unread-diff (- (or unread 0) cur-unread))
- (setq value (wl-folder-get-entity-info folder))
- (setq newvalue (list (nth 0 value)
- unread
- (nth 2 value)))
- (wl-folder-set-entity-info folder newvalue)
- (setq wl-folder-info-alist-modified t)
- (when (and buf
- (not (eq unread-diff 0)))
- (save-match-data
- (with-current-buffer buf
- (save-excursion
- (setq entity-list (wl-folder-search-entity-list-by-name
- folder wl-folder-entity))
+ (setq cur-unread (or (nth 1 value) 0))
+ (setq unread-diff (- (or unread 0) cur-unread))
+ (setq newvalue (list (nth 0 value)
+ unread
+ (nth 2 value)))
+ (wl-folder-set-entity-info folder newvalue)
+ (setq wl-folder-info-alist-modified t)
+ (when (and buf
+ (not (eq unread-diff 0)))
+ (save-match-data
+ (with-current-buffer buf
+ (save-excursion
+ (let ((entity-list (wl-folder-search-entity-list-by-name
+ folder wl-folder-entity)))
(while entity-list
(wl-folder-update-group (car entity-list) (list 0
unread-diff
0))
- (setq entity-list (cdr entity-list)))
- (goto-char (point-min))
- (while (wl-folder-buffer-search-entity folder)
- (wl-folder-update-line newvalue))))))));)
+ (setq entity-list (cdr entity-list))))
+ (goto-char (point-min))
+ (while (wl-folder-buffer-search-entity folder)
+ (wl-folder-update-line newvalue))))))))
(defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst)
(let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
(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)))
(set-buffer-modified-p nil))))))
(defun wl-folder-goto-folder (&optional arg)
+ "Visit some folder."
(interactive "P")
(wl-folder-goto-folder-subr nil arg))
(defun wl-folder-goto-folder-sticky ()
+ "Visit some folder and make it sticky."
(interactive)
(wl-folder-goto-folder-subr nil t))
(defun wl-folder-goto-draft-folder (&optional arg)
+ "Visit draft folder."
(interactive "P")
(wl-folder-goto-folder-subr wl-draft-folder arg))
+(defun wl-folder-revisit-last-visited-folder (&optional arg)
+ "Revisit last visited folder."
+ (interactive "P")
+ (let ((folder
+ (wl-folder-get-folder-name-by-id wl-folder-buffer-last-visited-entity-id)))
+ (if (and folder
+ (y-or-n-p (format "Revisit %s? " folder)))
+ (wl-folder-goto-folder-subr folder arg))))
+
(defun wl-folder-goto-folder-subr (&optional folder sticky)
(beginning-of-line)
(let (summary-buf fld-name entity id error-selecting)
(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)
(defun wl-folder-open-close ()
"Open or close parent entity."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (wl-folder-buffer-group-p)
- ;; if group (whether opend or closed.)
- (wl-folder-jump-to-current-entity)
- ;; if folder
- (let (indent)
- (setq indent (save-excursion
- (re-search-forward "\\([ ]*\\)." nil t)
- (wl-match-buffer 1)))
- (while (looking-at indent)
- (forward-line -1)))
- (wl-folder-jump-to-current-entity))))
+ (unless (wl-folder-get-entity-from-buffer)
+ (error "No folder"))
+ (beginning-of-line)
+ (if (wl-folder-buffer-group-p)
+ ;; if group (whether opend or closed.)
+ (wl-folder-jump-to-current-entity)
+ ;; if folder
+ (let (indent)
+ (setq indent (save-excursion
+ (re-search-forward "\\([ ]*\\)." nil t)
+ (wl-match-buffer 1)))
+ (while (looking-at indent)
+ (forward-line -1)))
+ (wl-folder-jump-to-current-entity)))
(defsubst wl-folder-access-subscribe-p (group folder)
(let (subscr regexp match)
(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
(mapcar (lambda (x) (list (concat (downcase x) ":")))
(append '("last" "first"
"from" "subject" "to" "cc" "body"
- "since" "before" "tocc")
+ "since" "before" "tocc"
+ "larger" "smaller")
elmo-msgdb-extra-fields))))
(if (not flag)
(try-completion string candidate)
projects / elisp / wanderlust.git / blobdiff