(defvar wl-folder-newsgroups-hashtb nil)
(defvar wl-folder-info-alist-modified nil)
-(defvar wl-folder-completion-function nil)
(defvar wl-folder-mode-map nil)
""))))
(defmacro wl-folder-buffer-group-p ()
- (` (save-excursion (beginning-of-line)
- (looking-at wl-folder-group-regexp))))
-
-(defmacro wl-folder-folder-name ()
- (` (save-excursion
- (beginning-of-line)
- (if (or (looking-at "^[ ]*\\[[\\+-]\\]\\(.+\\):[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+\n")
- (looking-at "^[ ]*\\([^\\[].+\\):.*\n"))
- (wl-match-buffer 1)))))
-
-(defmacro wl-folder-entity-name ()
- (` (save-excursion
- (beginning-of-line)
- (if (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
- (wl-match-buffer 1)))))
+ (` (get-text-property (point) 'wl-folder-is-group)))
(defun wl-folder-buffer-search-group (group)
- (re-search-forward
- (concat
- "^\\([ \t]*\\)\\[[\\+-]\\]"
- (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t))
+ (let ((prev-point (point))
+ (group-regexp (concat
+ "^\\([ \t]*\\)\\[[\\+-]\\]"
+ (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+")))
+ (or (catch 'found
+ (while (re-search-forward group-regexp nil t)
+ (if (wl-folder-buffer-group-p)
+ (throw 'found (point)))))
+ (progn ; not found
+ (goto-char prev-point)
+ nil))))
(defun wl-folder-buffer-search-entity (folder &optional searchname)
(let ((search (or searchname (wl-folder-get-petname folder)))
(` (elmo-set-hash-val (, name) (, folder)
(or (, hashtb) wl-folder-elmo-folder-hashtb))))
+(defun wl-draft-get-folder ()
+ "A function to obtain `opened' draft elmo folder structure."
+ (if (and wl-draft-folder-internal
+ (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))
+ (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)
- "Get elmo folder structure from entity."
- (` (if (, no-cache)
- (elmo-make-folder (elmo-string (, entity)))
- (or (wl-folder-elmo-folder-cache-get (, entity))
- (let* ((name (elmo-string (, entity)))
+ "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)))))
+(defsubst wl-folder-put-folder-property (beg end id is-group &optional object)
+ (put-text-property beg end 'wl-folder-entity-id id object)
+ (put-text-property beg end 'wl-folder-is-group is-group object))
+
(defun wl-folder-prev-entity ()
(interactive)
(forward-line -1))
(forward-line 1))
(defun wl-folder-prev-entity-skip-invalid (&optional hereto)
- "move to previous entity. skip unsubscribed or removed entity."
+ "Move to previous entity. skip unsubscribed or removed entity."
(interactive)
(if hereto
(end-of-line))
(beginning-of-line)
(let (entity beg end indent opened fname err fld-name)
(cond
- ((looking-at wl-folder-group-regexp)
+ ((and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp))
(save-excursion
- (setq fname (wl-folder-get-realname (wl-match-buffer 3)))
+ (setq fname (wl-folder-get-entity-from-buffer))
(setq indent (wl-match-buffer 1))
(setq opened (wl-match-buffer 2))
(if (string= opened "+")
; (wl-delete-all-overlays)
; (wl-highlight-folder-current-line)
)))
- ((setq fld-name (wl-folder-entity-name))
+ ((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
(defun wl-folder-update-recursive-current-entity (&optional entity)
(interactive)
- (when (wl-folder-buffer-group-p)
+ (beginning-of-line)
+ (when (and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp))
(cond
((string= (wl-match-buffer 2) "+")
(save-excursion
(if entity ()
(setq entity
(wl-folder-search-group-entity-by-name
- (wl-folder-get-realname (wl-match-buffer 3))
+ (wl-folder-get-entity-from-buffer)
wl-folder-entity)))
(let ((inhibit-read-only t)
(entities (list entity))
(t
(message "Uncheck(unplugged) \"%s\"" entity)))))
(if ret-val
- (message "Checking \"%s\" is done."
+ (message "Checking \"%s\" is done"
(if (consp entity) (car entity) entity)))
(run-hooks 'wl-folder-check-entity-hook)
ret-val))
(elmo-folder-diff folder)))
(error
;; maybe not exist folder.
- (if (and (not (memq 'elmo-open-error
- (get (car err) 'error-conditions)))
+ (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)))
(wl-folder-create-subr folder)
(signal (car err) (cdr err))))))
all (and all (max 0 all))))
(setq unread (or (and unread (- unread (or new 0)))
(elmo-folder-get-info-unread folder)
- (cdr (wl-summary-count-unread))))
+ (nth 1 (elmo-folder-count-flags folder))))
(wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
(list new unread all)
(get-buffer wl-folder-buffer-name)))
(select-window buf-win)
(set-buffer buf))
(setq wl-folder-buffer-cur-entity-id entity-id)
- (setq wl-folder-buffer-cur-path (wl-folder-get-path wl-folder-entity
- entity-id))
+ (setq wl-folder-buffer-cur-path
+ (wl-folder-get-path wl-folder-entity entity-id))
(wl-highlight-folder-path wl-folder-buffer-cur-path)
(and wl-folder-move-cur-folder
wl-folder-buffer-cur-point
(group (wl-folder-buffer-group-p))
summary-buf)
(when (and entity-name
- (y-or-n-p (format "Mark all messages in %s as read? " entity-name)))
+ (y-or-n-p (format "Mark all messages in %s as read? "
+ entity-name)))
(wl-folder-mark-as-read-all-entity
(if group
(wl-folder-search-group-entity-by-name entity-name
(get-text-property 0
'wl-folder-entity-id
(car entity))))
- (put-text-property 0 (length (car entity))
- 'wl-folder-entity-id
- wl-folder-entity-id
- (car entity))
+ (wl-folder-put-folder-property
+ 0 (length (car entity))
+ wl-folder-entity-id
+ 'is-group
+ (car entity))
(wl-folder-set-id-name wl-folder-entity-id
(car entity) hashtb))
(and entities
(get-text-property 0
'wl-folder-entity-id
entity)))
- (put-text-property 0 (length entity)
- 'wl-folder-entity-id
- wl-folder-entity-id
- entity)
+ (wl-folder-put-folder-property
+ 0 (length entity)
+ wl-folder-entity-id
+ nil
+ entity)
(wl-folder-set-id-name wl-folder-entity-id
entity hashtb))))
(setq wl-folder-entity-id (+ 1 wl-folder-entity-id))
(if (or (wl-folder-buffer-group-p)
(not plugged)
(setq entity
- (wl-folder-get-realname
- (wl-folder-folder-name)))
+ (wl-folder-get-entity-from-buffer))
(elmo-folder-plugged-p entity))
(throw 'found t))))
(beginning-of-line)
(if (re-search-backward (wl-folder-unread-regex group) nil t)
(progn
(beginning-of-line)
- (wl-folder-folder-name))
+ (wl-folder-get-entity-from-buffer))
(goto-char start-point)
(message "No more unread folder")
nil)))
(if (re-search-forward (wl-folder-unread-regex group) nil t)
(progn
(beginning-of-line)
- (wl-folder-folder-name))
+ (wl-folder-get-entity-from-buffer))
(goto-char start-point)
(message "No more unread folder")
nil)))
;;; wl-folder-newsgroups-hashtb))))
;;; (message "fetching folder entries...done"))
(insert indent "[" (if as-opened "-" "+") "]"
- (wl-folder-get-petname (car entity)))
+ (if (eq (cadr entity) 'access)
+ (wl-folder-get-petname (car entity))
+ (car entity)))
(setq group-name-end (point))
(insert ":0/0/0\n")
- (put-text-property beg (point) 'wl-folder-entity-id
- (get-text-property 0 'wl-folder-entity-id
- (car entity)))
+ (wl-folder-put-folder-property
+ beg (point)
+ (get-text-property 0 'wl-folder-entity-id (car entity))
+ 'is-group)
(when removed
(setq beg (point))
(while removed
(elmo-display-progress
'wl-folder-insert-entity "Inserting group %s..."
(/ (* i 100) len) (car entity)))
- (setq flist (cdr flist))))
+ (setq flist (cdr flist)))
+ (if (> len 0)
+ (message "Inserting group %s...done" (car entity))))
(save-excursion
(goto-char group-name-end)
(delete-region (point) (save-excursion (end-of-line)
(wl-highlight-folder-current-line ret-val)))
(setq ret-val (wl-folder-calc-finfo entity))
(insert indent "[" (if as-opened "-" "+") "]"
- (wl-folder-get-petname (car entity))
+ (if (eq (cadr entity) 'access)
+ (wl-folder-get-petname (car entity))
+ (car entity))
(format ":%d/%d/%d"
(or (nth 0 ret-val) 0)
(or (nth 1 ret-val) 0)
(or (nth 2 ret-val) 0))
"\n")
- (put-text-property beg (point) 'wl-folder-entity-id
- (get-text-property 0 'wl-folder-entity-id
- (car entity)))
+ (wl-folder-put-folder-property
+ beg (point)
+ (get-text-property 0 'wl-folder-entity-id (car entity))
+ 'is-group)
(save-excursion (forward-line -1)
(wl-highlight-folder-current-line ret-val)))))
((stringp entity)
(+ (nth 0 nums)(nth 1 nums))))
"*")
(or (setq all (nth 2 nums)) "*")))
- (put-text-property beg (point) 'wl-folder-entity-id
- (get-text-property 0 'wl-folder-entity-id entity))
+ (wl-folder-put-folder-property
+ beg (point)
+ (get-text-property 0 'wl-folder-entity-id entity)
+ nil)
(save-excursion (forward-line -1)
(wl-highlight-folder-current-line nums))
(setq ret-val (list new unread all)))))
nil)))
(defun wl-folder-guess-mailing-list-by-refile-rule (entity)
- "Return ML address guess by FOLDER.
+ "Return ML address guess by ENTITY.
Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'."
(let ((flist
(elmo-folder-get-primitive-list
(elmo-string-matched-member tokey wl-subscribed-mailing-list t)))))
(defun wl-folder-guess-mailing-list-by-folder-name (entity)
- "Return ML address guess by FOLDER name's last hierarchy.
+ "Return ML address guess by ENTITY name's last hierarchy.
Use `wl-subscribed-mailing-list'."
(let ((flist
(elmo-folder-get-primitive-list
cur-new new-new
cur-unread new-unread
cur-all new-all
- id)
+ id is-group)
(save-excursion
(beginning-of-line)
(setq id (get-text-property (point) 'wl-folder-entity-id))
+ (setq is-group (get-text-property (point) 'wl-folder-is-group))
(when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)")
;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
(setq cur-new (string-to-int
(setq new-new (+ cur-new (nth 0 diffs)))
(setq new-unread (+ cur-unread (nth 1 diffs)))
(setq new-all (+ cur-all (nth 2 diffs)))))
- (put-text-property (match-beginning 2) (point)
- 'wl-folder-entity-id id)
+ (wl-folder-put-folder-property (match-beginning 2) (point) id is-group)
(if wl-use-highlight-mouse-line
(put-text-property (match-beginning 2) (point)
'mouse-face 'highlight))
(defun wl-folder-update-line (nums &optional is-group)
(let ((inhibit-read-only t)
(buffer-read-only nil)
- id)
+ id is-group)
(save-excursion
(beginning-of-line)
(setq id (get-text-property (point) 'wl-folder-entity-id))
+ (setq is-group (get-text-property (point) 'wl-folder-is-group))
(if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
;;; (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
(progn
(+ (nth 0 nums)(nth 1 nums)))
"*")
(or (nth 2 nums) "*")))
- (put-text-property (match-beginning 2) (point)
- 'wl-folder-entity-id id)
+ (wl-folder-put-folder-property (match-beginning 2) (point) id is-group)
(if is-group
;; update only colors
(wl-highlight-folder-group-line nums)
(car path))))))
(beginning-of-line)
(setq path (cdr path))
- (if (and (looking-at wl-folder-group-regexp)
+ (if (and (wl-folder-buffer-group-p)
+ (looking-at wl-folder-group-regexp)
(string= "+" (wl-match-buffer 2)));; closed group
(save-excursion
(setq indent (wl-match-buffer 1))
- (setq name (wl-folder-get-realname (wl-match-buffer 3)))
+ (setq name (wl-folder-get-entity-from-buffer))
(setq entity (wl-folder-search-group-entity-by-name
name
wl-folder-entity))
(save-excursion
(goto-char (point-min))
(while (re-search-forward
- "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n"
+ "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$"
nil t)
(setq indent (wl-match-buffer 1))
- (setq name (wl-folder-get-realname (wl-match-buffer 3)))
+ (setq name (wl-folder-get-entity-from-buffer))
(setq entity (wl-folder-search-group-entity-by-name
name
wl-folder-entity))
;; insert as opened
(setcdr (assoc (car entity) wl-folder-group-alist) t)
- (forward-line -1)
+ (beginning-of-line)
(wl-folder-insert-entity indent entity)
(delete-region (save-excursion (beginning-of-line)
(point))
folder))))
;; Sticky folder exists.
(wl-summary-sticky-buffer-name
- (elmo-folder-name-internal folder))
+ (elmo-folder-name-internal folder))
(concat
wl-summary-buffer-name
(symbol-name this-command))))
(cons 0 0))))))
(defun wl-folder-count-incorporates (folder)
- (let ((marks (elmo-msgdb-mark-load
- (elmo-folder-msgdb-path folder)))
- (sum 0))
- (while marks
- (if (member (cadr (car marks))
- wl-summary-incorporate-marks)
- (incf sum))
- (setq marks (cdr marks)))
+ (let ((sum 0))
+ (dolist (number (elmo-folder-list-flagged folder 'any))
+ (when (member (wl-summary-message-mark folder number)
+ wl-summary-incorporate-marks)
+ (incf sum)))
sum))
(defun wl-folder-prefetch-current-entity (&optional no-check)
(interactive)
(unless (wl-folder-buffer-group-p)
(wl-summary-write-current-folder
- (wl-folder-get-realname (wl-folder-entity-name)))))
+ (wl-folder-get-entity-from-buffer))))
(defun wl-folder-mimic-kill-buffer ()
"Kill the current (Folder) buffer with query."
(unless (elmo-folder-exists-p folder)
(wl-folder-create-subr folder))
(unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder))
- (file-exists-p (elmo-folder-msgdb-path folder))
+ (and (elmo-folder-msgdb-path folder)
+ (file-exists-p (elmo-folder-msgdb-path folder)))
(elmo-folder-exists-p folder))
(wl-folder-create-subr folder))))
(switch-to-buffer-other-window (car (wl-collect-summary))))
(wl-summary-previous-buffer)))
+;;;
+;; Completion
+(defvar wl-folder-complete-folder-candidate nil)
+
+(defun wl-folder-complete-folder (string predicate flag)
+ (cond ((or (string-match "^\\(/[^/]*/\\)\\(.*\\)$" string) ; filter
+ (string-match "^\\(\*\\|\*.*,\\)\\([^,]*\\)$" string) ; multi
+ (string-match "^\\(|[^|]*|:?\\)\\(.*\\)$" string) ;pipe-src
+ (string-match "^\\(|\\)\\([^|]*\\)$" string)) ;pipe-dst
+ (let* ((str1 (match-string 1 string))
+ (str2 (match-string 2 string))
+ (str2-comp (wl-folder-complete-folder str2 predicate flag)))
+ (cond
+ ((listp str2-comp) ; flag=t
+ (mapcar (lambda (x) (concat str1 x)) str2-comp))
+ ((stringp str2-comp)
+ (concat str1 str2-comp))
+ (t
+ str2-comp))))
+ ((string-match "^\\(/\\)\\([^/]*\\)$" string) ; filter-condition
+ (let* ((str1 (match-string 1 string))
+ (str2 (match-string 2 string))
+ (str2-comp
+ (wl-folder-complete-filter-condition str2 predicate flag)))
+ (cond
+ ((listp str2-comp) ; flag=t
+ (mapcar (lambda (x) (concat str1 x)) str2-comp))
+ ((stringp str2-comp)
+ (concat str1 str2-comp))
+ (t
+ str2-comp))))
+ (t
+ (let ((candidate
+ (or wl-folder-complete-folder-candidate
+ (if (memq 'read-folder wl-use-folder-petname)
+ (wl-folder-get-entity-with-petname)
+ wl-folder-entity-hashtb))))
+ (if (not flag)
+ (try-completion string candidate)
+ (all-completions string candidate))))))
+
+(defun wl-folder-complete-filter-condition (string predicate flag)
+ (cond
+ ((string-match "^\\(.*|\\|.*&\\|.*!\\|.*(\\)\\([^:]*\\)$" string)
+ (let* ((str1 (match-string 1 string))
+ (str2 (match-string 2 string))
+ (str2-comp
+ (wl-folder-complete-filter-condition str2 predicate flag)))
+ (cond
+ ((listp str2-comp) ; flag=t
+ (mapcar (lambda (x) (concat str1 x)) str2-comp))
+ ((stringp str2-comp)
+ (concat str1 str2-comp))
+ (t
+ 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))))
+ (if (not flag)
+ (try-completion string candidate)
+ (all-completions string candidate))))))
+
(require 'product)
(product-provide (provide 'wl-folder) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff