;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
-;; Time-stamp: <00/03/22 00:14:31 teranisi>
;; This file is part of ELMO (Elisp Library for Message Orchestration).
(expand-file-name
(let ((file (file-name-completion (symbol-name location)
(expand-file-name "cur" dir))))
- (if (eq file t) location file))
+ (if (eq file t) (symbol-name location) file))
(expand-file-name "cur" dir)))
(defsubst elmo-maildir-list-location (dir &optional child-dir)
nil "^[^.].*$" t))
seen-list seen sym list)
(setq list
- (mapcar
+ (mapcar
(lambda (x)
(if (string-match "^\\([^:]+\\):\\([^:]+\\)$" x)
(progn
(let ((cur-time (current-time))
(count 0)
last-accessed)
- (mapcar (function
+ (mapcar (function
(lambda (file)
(setq last-accessed (nth 4 (file-attributes file)))
(when (or (> (- (car cur-time)(car last-accessed)) 1)
"^[^.].*$" t))))
(defun elmo-maildir-update-current (spec)
- "Move all new msgs to cur in the maildir"
+ "Move all new msgs to cur in the maildir."
(let* ((maildir (elmo-maildir-get-folder-directory spec))
(news (directory-files (expand-file-name "new"
maildir)
;; cleanup tmp directory.
(elmo-maildir-cleanup-temporal maildir)
;; move new msgs to cur directory.
- (mapcar (lambda (x)
- (rename-file
- (expand-file-name x (expand-file-name "new" maildir))
- (expand-file-name (concat x ":2,")
- (expand-file-name "cur" maildir))))
- news)))
+ (while news
+ (rename-file
+ (expand-file-name (car news) (expand-file-name "new" maildir))
+ (expand-file-name (concat (car news) ":2,")
+ (expand-file-name "cur" maildir)))
+ (setq news (cdr news)))))
(defun elmo-maildir-set-mark (filename mark)
- "Mark the file in the maildir. MARK is a character."
- (if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
- (let ((flaglist (string-to-char-list (elmo-match-string
+ "Mark the FILENAME file in the maildir. MARK is a character."
+ (if (string-match "^\\([^:]+:[12],\\)\\(.*\\)$" filename)
+ (let ((flaglist (string-to-char-list (elmo-match-string
2 filename))))
(unless (memq mark flaglist)
(setq flaglist (sort (cons mark flaglist) '<))
(rename-file filename
(concat (elmo-match-string 1 filename)
- (char-list-to-string flaglist)))))))
+ (char-list-to-string flaglist)))))
+ ;; Rescue no info file in maildir.
+ (rename-file filename
+ (concat filename ":2," (char-to-string mark)))))
(defun elmo-maildir-delete-mark (filename mark)
- "Mark the file in the maildir. MARK is a character."
+ "Mark the FILENAME file in the maildir. MARK is a character."
(if (string-match "^\\([^:]+:2,\\)\\(.*\\)$" filename)
- (let ((flaglist (string-to-char-list (elmo-match-string
+ (let ((flaglist (string-to-char-list (elmo-match-string
2 filename))))
(when (memq mark flaglist)
(setq flaglist (delq mark flaglist))
(let ((dir (elmo-maildir-get-folder-directory spec))
(locs (if msgdb
(elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path nil spec))))
+ (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
file)
(while msgs
(if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
(let ((dir (elmo-maildir-get-folder-directory spec))
(locs (if msgdb
(elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path nil spec))))
+ (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))
file)
(while msgs
(if (setq file (elmo-maildir-number-to-filename dir (car msgs) locs))
(defun elmo-maildir-mark-as-unread (spec msgs &optional msgdb)
(elmo-maildir-delete-mark-msgs spec ?S msgs msgdb))
-(defun elmo-maildir-msgdb-create (spec numlist new-mark
- already-mark seen-mark
- important-mark
+(defun elmo-maildir-msgdb-create (spec numlist new-mark
+ already-mark seen-mark
+ important-mark
seen-list
&optional msgdb)
(when numlist
(let* ((dir (elmo-maildir-get-folder-directory spec))
(loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec))))
+ (elmo-msgdb-location-load (elmo-msgdb-expand-path
+ spec))))
(loc-seen (elmo-maildir-list-location dir))
(loc-list (car loc-seen))
(seen-list (cdr loc-seen))
dir (car numlist) loc-alist))
(if (null entity)
()
- (setq overview
+ (setq overview
(elmo-msgdb-append-element
overview entity))
(setq number-alist
(setq location (cdr (assq (car numlist) loc-alist)))
(unless (member location seen-list)
(setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
(elmo-msgdb-overview-entity-get-number
entity)
- (or (elmo-msgdb-global-mark-get
+ (or (elmo-msgdb-global-mark-get
(elmo-msgdb-overview-entity-get-id
entity))
new-mark)))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-maildir-msgdb-create "Creating msgdb..."
- percent)
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-maildir-msgdb-create "Creating msgdb..."
+ percent))
(setq numlist (cdr numlist)))
- (message "Creating msgdb...done.")
- (list overview number-alist mark-alist loc-alist))))
+ (message "Creating msgdb...done")
+ (elmo-msgdb-sort-by-date
+ (list overview number-alist mark-alist loc-alist)))))
(defalias 'elmo-maildir-msgdb-create-as-numlist 'elmo-maildir-msgdb-create)
(not (or (listp folder) (elmo-folder-exists-p folder)))))
folders)))
-(static-cond
+(static-cond
((>= emacs-major-version 19)
(defun elmo-maildir-make-unique-string ()
"This function generates a string that can be used as a unique
-file name for maildir directories."
+file name for maildir directories."
(let ((cur-time (current-time)))
(format "%.0f.%d_%d.%s"
(+ (* (car cur-time)
(float-to-string
(f+ (f* (f (car time))
(f 65536))
- (f (cadr time))))
- 0 5)
+ (f (cadr time))))
+ 0 5)
(cadr time)
(% (abs (random t)) 10000); dummy pid
(system-name))))))
(defun elmo-maildir-temporal-filename (basedir)
- (let ((filename (expand-file-name
+ (let ((filename (expand-file-name
(concat "tmp/" (elmo-maildir-make-unique-string))
basedir)))
(unless (file-exists-p (file-name-directory filename))
(make-directory (file-name-directory filename)))
(while (file-exists-p filename)
- ;; (sleep-for 2) ; I don't want to wait.
- (setq filename
- (expand-file-name
+;;; I don't want to wait.
+;;; (sleep-for 2)
+ (setq filename
+ (expand-file-name
(concat "tmp/" (elmo-maildir-make-unique-string))
basedir)))
filename))
;; add link from new.
(elmo-add-name-to-file
filename
- (expand-file-name
+ (expand-file-name
(concat "new/" (file-name-nondirectory filename))
basedir))
t)
(let ((dir (elmo-maildir-get-folder-directory spec))
file)
(setq file (elmo-maildir-number-to-filename dir number loc-alist))
- (if (and (file-writable-p file)
+ (if (and (file-writable-p file)
(not (file-directory-p file)))
(progn (delete-file file)
t))))
(defun elmo-maildir-read-msg (spec number outbuf &optional msgdb)
(save-excursion
(let* ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec))))
+ (elmo-msgdb-location-load (elmo-msgdb-expand-path
+ spec))))
(dir (elmo-maildir-get-folder-directory spec))
(file (elmo-maildir-number-to-filename dir number loc-alist)))
(set-buffer outbuf)
(defun elmo-maildir-delete-msgs (spec msgs &optional msgdb)
(let ((loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec)))))
+ (elmo-msgdb-location-load (elmo-msgdb-expand-path
+ spec)))))
(mapcar '(lambda (msg) (elmo-maildir-delete-msg spec msg
loc-alist))
msgs)))
(defsubst elmo-maildir-list-folder-subr (spec &optional nonsort)
(let* ((dir (elmo-maildir-get-folder-directory spec))
- (flist (elmo-list-folder-by-location
+ (flist (elmo-list-folder-by-location
spec
(car (elmo-maildir-list-location dir))))
- (news (car (elmo-maildir-list-location dir "new"))))
+ (killed (and elmo-use-killed-list
+ (elmo-msgdb-killed-list-load
+ (elmo-msgdb-expand-path spec))))
+ (news (car (elmo-maildir-list-location dir "new")))
+ numbers)
(if nonsort
(cons (+ (or (elmo-max-of-list flist) 0) (length news))
- (+ (length flist) (length news)))
- (sort flist '<))))
+ (+ (length news)
+ (if killed
+ (- (length flist)
+ (elmo-msgdb-killed-list-length killed))
+ (length flist))))
+ (setq numbers (sort flist '<))
+ (elmo-living-messages numbers killed))))
(defun elmo-maildir-list-folder (spec)
(elmo-maildir-update-current spec)
(lambda (dir)
(setq dir (expand-file-name dir basedir))
(if (not (file-directory-p dir))
- (error)
+ (error nil)
(elmo-delete-directory dir t))))
'("new" "cur" "tmp" "."))
t)
- (error))))
+ (error nil))))
(defun elmo-maildir-search (spec condition &optional from-msgs msgdb)
(save-excursion
(let* ((msgs (or from-msgs (elmo-maildir-list-folder spec)))
(loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load (elmo-msgdb-expand-path
- nil spec))))
+ (elmo-msgdb-location-load (elmo-msgdb-expand-path
+ spec))))
(dir (elmo-maildir-get-folder-directory spec))
(i 0)
case-fold-search ret-val
percent num
(num (length msgs))
- msg-num)
+ number-list msg-num)
+ (setq number-list msgs)
(while msgs
(setq msg-num (car msgs))
- (if (elmo-file-field-condition-match
+ (if (elmo-file-field-condition-match
(elmo-maildir-number-to-filename
dir (car msgs) loc-alist)
- condition)
+ condition (car msgs) number-list)
(setq ret-val (append ret-val (list msg-num))))
(setq i (1+ i))
(setq percent (/ (* i 100) num))
ret-val)))
;;; (maildir) -> maildir
-(defun elmo-maildir-copy-msgs (dst-spec msgs src-spec
+(defun elmo-maildir-copy-msgs (dst-spec msgs src-spec
&optional loc-alist same-number)
(let (srcfile)
(while msgs
- (setq srcfile
+ (setq srcfile
(elmo-maildir-get-msg-filename src-spec (car msgs) loc-alist))
(elmo-copy-file
;; src file
srcfile
;; dst file
- (expand-file-name
+ (expand-file-name
(file-name-nondirectory srcfile)
(concat (elmo-maildir-get-folder-directory dst-spec) "/cur")))
(setq msgs (cdr msgs))))
t)
(defun elmo-maildir-get-msg-filename (spec number &optional loc-alist)
- (elmo-maildir-number-to-filename
+ (elmo-maildir-number-to-filename
(elmo-maildir-get-folder-directory spec)
- number (or loc-alist (elmo-msgdb-location-load
- (elmo-msgdb-expand-path
- nil spec)))))
-
-(defalias 'elmo-maildir-sync-number-alist
+ number (or loc-alist (elmo-msgdb-location-load
+ (elmo-msgdb-expand-path
+ spec)))))
+
+(defun elmo-maildir-pack-number (spec msgdb arg)
+ (let ((old-number-alist (elmo-msgdb-get-number-alist msgdb))
+ (old-overview (elmo-msgdb-get-overview msgdb))
+ (old-mark-alist (elmo-msgdb-get-mark-alist msgdb))
+ (old-location (elmo-msgdb-get-location msgdb))
+ old-number overview number-alist mark-alist location
+ mark (number 1))
+ (setq overview old-overview)
+ (while old-overview
+ (setq old-number
+ (elmo-msgdb-overview-entity-get-number (car old-overview)))
+ (elmo-msgdb-overview-entity-set-number (car old-overview) number)
+ (setq number-alist
+ (cons (cons number (cdr (assq old-number old-number-alist)))
+ number-alist))
+ (when (setq mark (cadr (assq old-number old-mark-alist)))
+ (setq mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist number mark)))
+ (setq location
+ (cons (cons number (cdr (assq old-number old-location)))
+ location))
+ (setq number (1+ number))
+ (setq old-overview (cdr old-overview)))
+ ;; XXX Should consider when folder is not persistent.
+ (elmo-msgdb-location-save (elmo-msgdb-expand-path spec) location)
+ (list overview
+ (nreverse number-alist)
+ (nreverse mark-alist)
+ (nreverse location)
+ (elmo-msgdb-make-overview-hashtb overview))))
+
+(defalias 'elmo-maildir-sync-number-alist
'elmo-generic-sync-number-alist)
-(defalias 'elmo-maildir-list-folder-unread
+(defalias 'elmo-maildir-list-folder-unread
'elmo-generic-list-folder-unread)
(defalias 'elmo-maildir-list-folder-important
'elmo-generic-list-folder-important)
+(defalias 'elmo-maildir-commit 'elmo-generic-commit)
+(defalias 'elmo-maildir-folder-diff 'elmo-generic-folder-diff)
-(provide 'elmo-maildir)
+(require 'product)
+(product-provide (provide 'elmo-maildir) (require 'elmo-version))
;;; elmo-maildir.el ends here
projects / elisp / wanderlust.git / blobdiff