(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)
(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)
+ (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))))
(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)))
(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