(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))))
(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))
+ elmo-folder)
+ (if buffer
+ (with-current-buffer buffer
+ (wl-summary-set-persistent-mark flag number))
+ ;; Parent buffer does not exist.
+ (when (setq elmo-folder (and 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)
+ (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 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
+ fld-name
wl-folder-entity))
(setq beg (point))
(if arg
(wl-highlight-folder-path wl-folder-buffer-cur-path))
; (quit
; (setq err t)
- ; (setcdr (assoc fname wl-folder-group-alist) nil))
+ ; (setcdr (assoc fld-name wl-folder-group-alist) nil))
; (error
; (elmo-display-error errobj t)
; (ding)
; (setq err t)
- ; (setcdr (assoc fname wl-folder-group-alist) nil)))
+ ; (setcdr (assoc fld-name wl-folder-group-alist) nil)))
(if (not err)
(let ((buffer-read-only nil))
(delete-region (save-excursion (beginning-of-line)
(beginning-of-line)
(point))))
(setq entity (wl-folder-search-group-entity-by-name
- fname
+ fld-name
wl-folder-entity))
(let ((buffer-read-only nil))
(delete-region beg end))
; (wl-highlight-folder-current-line)
))
;; ordinal folder
- (setq fld-name (wl-folder-get-entity-from-buffer))
(wl-folder-set-current-entity-id
(get-text-property (point) 'wl-folder-entity-id))
(setq fld-name (wl-folder-get-folder-name-by-id
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)))
'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))))
(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)
projects / elisp / wanderlust.git / blobdiff