(require 'elmo-util)
(require 'emu)
(require 'std11)
+(require 'mime)
+
+;;; MSGDB interface.
+(defun elmo-load-msgdb (path)
+ "Load the MSGDB from PATH."
+ (let ((inhibit-quit t))
+ (elmo-make-msgdb (elmo-msgdb-overview-load path)
+ (elmo-msgdb-number-load path)
+ (elmo-msgdb-mark-load path))))
+
+(defun elmo-make-msgdb (&optional overview number-alist mark-alist)
+ "Make a MSGDB."
+ (let ((msgdb (list overview number-alist mark-alist nil)))
+ (elmo-msgdb-make-index msgdb)
+ msgdb))
+
+(defsubst elmo-msgdb-get-mark (msgdb number)
+ "Get mark string from MSGDB which corresponds to the message with NUMBER."
+ (cadr (elmo-get-hash-val (format "#%d" number)
+ (elmo-msgdb-get-mark-hashtb msgdb))))
+
+(defsubst elmo-msgdb-set-mark (msgdb number mark)
+ "Set MARK of the message with NUMBER in the MSGDB.
+if MARK is nil, mark is removed."
+ (elmo-msgdb-set-mark-alist
+ msgdb
+ (elmo-msgdb-mark-alist-set (elmo-msgdb-get-mark-alist msgdb)
+ number
+ mark msgdb))
+ (unless mark
+ (elmo-clear-hash-val (format "#%d" number)
+ (elmo-msgdb-get-mark-hashtb msgdb))))
+
+(defsubst elmo-msgdb-count-marks (msgdb new-mark unread-marks)
+ (let ((new 0)
+ (unreads 0))
+ (dolist (elem (elmo-msgdb-get-mark-alist msgdb))
+ (cond
+ ((string= (cadr elem) new-mark)
+ (incf new))
+ ((member (cadr elem) unread-marks)
+ (incf unreads))))
+ (cons new unreads)))
+
+(defsubst elmo-msgdb-get-number (msgdb message-id)
+ "Get number of the message which corrensponds to MESSAGE-ID from MSGDB."
+ (elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-overview-get-entity message-id msgdb)))
+
+(defsubst elmo-msgdb-get-field (msgdb number field)
+ "Get FIELD value of the message with NUMBER from MSGDB."
+ (case field
+ (message-id (elmo-msgdb-overview-entity-get-id
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (subject (elmo-msgdb-overview-entity-get-subject
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (size (elmo-msgdb-overview-entity-get-size
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (date (elmo-msgdb-overview-entity-get-date
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (to (elmo-msgdb-overview-entity-get-to
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))
+ (cc (elmo-msgdb-overview-entity-get-cc
+ (elmo-msgdb-overview-get-entity
+ number msgdb)))))
+
+(defsubst elmo-msgdb-append (msgdb msgdb-append)
+ (list
+ (nconc (car msgdb) (car msgdb-append))
+ (nconc (cadr msgdb) (cadr msgdb-append))
+ (nconc (caddr msgdb) (caddr msgdb-append))
+ (elmo-msgdb-make-index
+ msgdb
+ (elmo-msgdb-get-overview msgdb-append)
+ (elmo-msgdb-get-mark-alist msgdb-append))))
+
+(defsubst elmo-msgdb-clear (&optional msgdb)
+ (if msgdb
+ (list
+ (setcar msgdb nil)
+ (setcar (cdr msgdb) nil)
+ (setcar (cddr msgdb) nil)
+ (setcar (nthcdr 3 msgdb) nil))
+ (list nil nil nil nil)))
+
+(defun elmo-msgdb-delete-msgs (msgdb msgs)
+ "Delete MSGS from MSGDB
+content of MSGDB is changed."
+ (let* ((overview (car msgdb))
+ (number-alist (cadr msgdb))
+ (mark-alist (caddr msgdb))
+ (index (elmo-msgdb-get-index msgdb))
+ (newmsgdb (list overview number-alist mark-alist index))
+ ov-entity)
+ ;; remove from current database.
+ (while msgs
+ (setq overview
+ (delq
+ (setq ov-entity
+ (elmo-msgdb-overview-get-entity (car msgs) newmsgdb))
+ overview))
+ (setq number-alist (delq (assq (car msgs) number-alist) number-alist))
+ (setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist))
+ ;;
+ (when index (elmo-msgdb-clear-index msgdb ov-entity))
+ (setq msgs (cdr msgs)))
+ (setcar msgdb overview)
+ (setcar (cdr msgdb) number-alist)
+ (setcar (cddr msgdb) mark-alist)
+ (setcar (nthcdr 3 msgdb) index)
+ t)) ;return value
+
+(defun elmo-msgdb-sort-by-date (msgdb)
+ (message "Sorting...")
+ (let ((overview (elmo-msgdb-get-overview msgdb)))
+ (setq overview (elmo-msgdb-overview-sort-by-date overview))
+ (message "Sorting...done")
+ (list overview (nth 1 msgdb)(nth 2 msgdb))))
+
+(defun elmo-msgdb-make-entity (&rest args)
+ "Make an msgdb entity."
+ (cons (plist-get args :message-id)
+ (vector (plist-get args :number)
+ (plist-get args :references)
+ (plist-get args :from)
+ (plist-get args :subject)
+ (plist-get args :date)
+ (plist-get args :to)
+ (plist-get args :cc)
+ (plist-get args :size)
+ (plist-get args :extra))))
+;;;
(defsubst elmo-msgdb-append-element (list element)
(if list
;;; (append list (list element))
(caddr msgdb))
;(defsubst elmo-msgdb-get-location (msgdb)
; (cadddr msgdb))
-(defsubst elmo-msgdb-get-overviewht (msgdb)
+
+(defsubst elmo-msgdb-get-index (msgdb)
(nth 3 msgdb))
+(defsubst elmo-msgdb-get-entity-hashtb (msgdb)
+ (car (nth 3 msgdb)))
+
+(defsubst elmo-msgdb-get-mark-hashtb (msgdb)
+ (cdr (nth 3 msgdb)))
+
;;
;; number <-> Message-ID handling
;;
ret-val))
;;;
-;; parsistent mark handling
-;; (for global!)
-
-(defvar elmo-msgdb-global-mark-alist nil)
-
-(defun elmo-msgdb-global-mark-delete (msgid)
- (let* ((path (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))
- (malist (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load path))))
- match)
- (when (setq match (assoc msgid malist))
- (setq elmo-msgdb-global-mark-alist
- (delete match elmo-msgdb-global-mark-alist))
- (elmo-object-save path elmo-msgdb-global-mark-alist))))
-
-(defun elmo-msgdb-global-mark-set (msgid mark)
- (let* ((path (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir))
- (malist (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load path))))
- match)
- (if (setq match (assoc msgid malist))
- (setcdr match mark)
- (setq elmo-msgdb-global-mark-alist
- (nconc elmo-msgdb-global-mark-alist
- (list (cons msgid mark)))))
- (elmo-object-save path elmo-msgdb-global-mark-alist)))
-
-(defun elmo-msgdb-global-mark-get (msgid)
- (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
- (setq elmo-msgdb-global-mark-alist
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-global-mark-filename
- elmo-msgdb-dir)))))))
-
-;;;
;; persistent mark handling
;; (for each folder)
-(defun elmo-msgdb-mark-set (alist id mark)
+(defun elmo-msgdb-mark-alist-set (alist id mark msgdb)
(let ((ret-val alist)
entity)
(setq entity (assq id alist))
(setq ret-val (delq entity alist))
;; set mark
(setcar (cdr entity) mark))
- (if mark
- (setq ret-val (elmo-msgdb-append-element ret-val
- (list id mark)))))
+ (when mark
+ (setq ret-val (elmo-msgdb-append-element ret-val
+ (setq entity
+ (list id mark))))
+ (elmo-set-hash-val (format "#%d" id) entity
+ (elmo-msgdb-get-mark-hashtb msgdb))))
ret-val))
(defun elmo-msgdb-mark-append (alist id mark)
(setq alist (elmo-msgdb-append-element alist
(list id mark))))
-(defun elmo-msgdb-mark-alist-to-seen-list (number-alist mark-alist seen-marks)
- "Make seen-list from MARK-ALIST."
- (let ((seen-mark-list (string-to-char-list seen-marks))
- ret-val ent)
- (while number-alist
- (if (setq ent (assq (car (car number-alist)) mark-alist))
- (if (and (cadr ent)
- (memq (string-to-char (cadr ent)) seen-mark-list))
- (setq ret-val (cons (cdr (car number-alist)) ret-val)))
- (setq ret-val (cons (cdr (car number-alist)) ret-val)))
- (setq number-alist (cdr number-alist)))
- ret-val))
+(defun elmo-msgdb-seen-list (msgdb seen-marks)
+ "Get SEEN-MSGID-LIST from MSGDB."
+ (let ((ov (elmo-msgdb-get-overview msgdb))
+ mark seen-list)
+ (while ov
+ (if (setq mark (elmo-msgdb-get-mark
+ msgdb
+ (elmo-msgdb-overview-entity-get-number (car ov))))
+ (if (and mark (member mark seen-marks))
+ (setq seen-list (cons
+ (elmo-msgdb-overview-entity-get-id (car ov))
+ seen-list)))
+ (setq seen-list (cons
+ (elmo-msgdb-overview-entity-get-id (car ov))
+ seen-list)))
+ (setq ov (cdr ov)))
+ seen-list))
;;
;; mime decode cache
(expand-file-name elmo-msgdb-overview-filename dir)
overview))
-(defun elmo-msgdb-search-internal-primitive (condition entity number-list)
- (let ((key (elmo-filter-key condition))
- (case-fold-search t)
- result)
- (cond
- ((string= key "last")
- (setq result (<= (length (memq
- (elmo-msgdb-overview-entity-get-number entity)
- number-list))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "first")
- (setq result (< (-
- (length number-list)
- (length (memq
- (elmo-msgdb-overview-entity-get-number entity)
- number-list)))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "from")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-from entity))))
- ((string= key "subject")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-subject entity))))
- ((string= key "to")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-to entity))))
- ((string= key "cc")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-cc entity))))
- ((or (string= key "since")
- (string= key "before"))
- (let ((res (string< (timezone-make-date-sortable
- (elmo-msgdb-overview-entity-get-date entity))
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition))))))
- (setq result (if (string= key "before") res (not res)))))
- ((member key elmo-msgdb-extra-fields)
- (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
- (if (stringp extval)
+(defun elmo-msgdb-match-condition-primitive (condition entity numbers)
+ (catch 'unresolved
+ (let ((key (elmo-filter-key condition))
+ (case-fold-search t)
+ result)
+ (cond
+ ((string= key "last")
+ (setq result (<= (length (memq
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ numbers))
+ (string-to-int (elmo-filter-value condition)))))
+ ((string= key "first")
+ (setq result (< (-
+ (length numbers)
+ (length (memq
+ (elmo-msgdb-overview-entity-get-number
+ entity)
+ numbers)))
+ (string-to-int (elmo-filter-value condition)))))
+ ((string= key "from")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-from entity))))
+ ((string= key "subject")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-subject entity))))
+ ((string= key "to")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-to entity))))
+ ((string= key "cc")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-overview-entity-get-cc entity))))
+ ((or (string= key "since")
+ (string= key "before"))
+ (let ((field-date (elmo-date-make-sortable-string
+ (timezone-fix-time
+ (elmo-msgdb-overview-entity-get-date entity)
+ (current-time-zone) nil)))
+ (specified-date
+ (elmo-date-make-sortable-string
+ (elmo-date-get-datevec
+ (elmo-filter-value condition)))))
+ (setq result (if (string= key "since")
+ (or (string= specified-date field-date)
+ (string< specified-date field-date))
+ (string< field-date specified-date)))))
+ ((member key elmo-msgdb-extra-fields)
+ (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
+ (when (stringp extval)
(setq result (string-match
(elmo-filter-value condition)
- extval))))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result)))
- result))
-
-(defun elmo-msgdb-search-internal (condition entity number-list)
+ extval)))))
+ (t
+ (throw 'unresolved condition)))
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (not result)
+ result))))
+
+(defun elmo-msgdb-match-condition (condition entity numbers)
(cond
((vectorp condition)
- (elmo-msgdb-search-internal-primitive condition entity number-list))
+ (elmo-msgdb-match-condition-primitive condition entity numbers))
((eq (car condition) 'and)
- (and (elmo-msgdb-search-internal
- (nth 1 condition) entity number-list)
- (elmo-msgdb-search-internal
- (nth 2 condition) entity number-list)))
+ (let ((lhs (elmo-msgdb-match-condition (nth 1 condition)
+ entity numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-match-condition (nth 2 condition)
+ entity numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'and lhs rhs))
+ (rhs
+ lhs))))
+ (lhs
+ (elmo-msgdb-match-condition (nth 2 condition)
+ entity numbers)))))
((eq (car condition) 'or)
- (or (elmo-msgdb-search-internal
- (nth 1 condition) entity number-list)
- (elmo-msgdb-search-internal
- (nth 2 condition) entity number-list)))))
-
-(defun elmo-msgdb-delete-msgs (msgdb msgs)
- "Delete MSGS from MSGDB
-content of MSGDB is changed."
- (save-excursion
- (let* (;(msgdb (elmo-folder-msgdb folder))
- (overview (car msgdb))
- (number-alist (cadr msgdb))
- (mark-alist (caddr msgdb))
- (hashtb (elmo-msgdb-get-overviewht msgdb))
- (newmsgdb (list overview number-alist mark-alist hashtb))
- ov-entity)
- ;; remove from current database.
- (while msgs
- (setq overview
- (delq
- (setq ov-entity
- (elmo-msgdb-overview-get-entity (car msgs) newmsgdb))
- overview))
- (when (and elmo-use-overview-hashtb hashtb)
- (elmo-msgdb-clear-overview-hashtb ov-entity hashtb))
- (setq number-alist
- (delq (assq (car msgs) number-alist) number-alist))
- (setq mark-alist (delq (assq (car msgs) mark-alist) mark-alist))
- (setq msgs (cdr msgs)))
- ;(elmo-folder-set-message-modified-internal folder t)
- (setcar msgdb overview)
- (setcar (cdr msgdb) number-alist)
- (setcar (cddr msgdb) mark-alist)
- (setcar (nthcdr 3 msgdb) hashtb))
- t)) ;return value
+ (let ((lhs (elmo-msgdb-match-condition (nth 1 condition)
+ entity numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-match-condition (nth 2 condition)
+ entity numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'or lhs rhs))
+ (rhs
+ t)
+ (t
+ lhs))))
+ (lhs
+ t)
+ (t
+ (elmo-msgdb-match-condition (nth 2 condition)
+ entity numbers)))))))
(defsubst elmo-msgdb-set-overview (msgdb overview)
(setcar msgdb overview))
(defsubst elmo-msgdb-set-mark-alist (msgdb mark-alist)
(setcar (cddr msgdb) mark-alist))
+(defsubst elmo-msgdb-set-index (msgdb index)
+ (setcar (cdddr msgdb) index))
+
(defsubst elmo-msgdb-overview-entity-get-references (entity)
(and entity (aref (cdr entity) 1)))
;; entity is parent-id.
(and entity (assoc entity database)))
+(defsubst elmo-msgdb-get-parent-entity (entity msgdb)
+ (setq entity (elmo-msgdb-overview-entity-get-references entity))
+ ;; entity is parent-id.
+ (and entity (elmo-msgdb-overview-get-entity entity msgdb)))
+
(defsubst elmo-msgdb-overview-entity-get-number (entity)
(and entity (aref (cdr entity) 0)))
(defun elmo-msgdb-overview-get-entity (id msgdb)
(when id
- (let ((ovht (elmo-msgdb-get-overviewht msgdb)))
- (if ovht ; use overview hash
+ (let ((ht (elmo-msgdb-get-entity-hashtb msgdb)))
+ (if ht
(if (stringp id) ;; ID is message-id
- (elmo-get-hash-val id ovht)
- (elmo-get-hash-val (format "#%d" id) ovht))
- (let* ((overview (elmo-msgdb-get-overview msgdb))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- (message-id (if (stringp id)
- id ;; ID is message-id
- (cdr (assq id number-alist))))
- entity)
- (if message-id
- (assoc message-id overview)
- ;; ID is number. message-id is nil or no exists in number-alist.
- (elmo-msgdb-overview-get-entity-by-number overview id)))))))
+ (elmo-get-hash-val id ht)
+ (elmo-get-hash-val (format "#%d" id) ht))))))
;;
;; deleted message handling
(defun elmo-msgdb-finfo-load ()
(elmo-object-load (expand-file-name
elmo-msgdb-finfo-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
elmo-mime-charset t))
(defun elmo-msgdb-finfo-save (finfo)
(elmo-object-save (expand-file-name
elmo-msgdb-finfo-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
finfo elmo-mime-charset))
(defun elmo-msgdb-flist-load (fname)
elmo-msgdb-flist-filename
(expand-file-name
(elmo-safe-filename fname)
- (expand-file-name "folder" elmo-msgdb-dir)))))
+ (expand-file-name "folder" elmo-msgdb-directory)))))
(elmo-object-load flist-file elmo-mime-charset t)))
(defun elmo-msgdb-flist-save (fname flist)
elmo-msgdb-flist-filename
(expand-file-name
(elmo-safe-filename fname)
- (expand-file-name "folder" elmo-msgdb-dir)))))
+ (expand-file-name "folder" elmo-msgdb-directory)))))
(elmo-object-save flist-file flist elmo-mime-charset)))
(defun elmo-crosspost-alist-load ()
(elmo-object-load (expand-file-name
elmo-crosspost-alist-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
nil t))
(defun elmo-crosspost-alist-save (alist)
(elmo-object-save (expand-file-name
elmo-crosspost-alist-filename
- elmo-msgdb-dir)
+ elmo-msgdb-directory)
alist))
(defun elmo-msgdb-add-msgs-to-seen-list (msgs msgdb unread-marks seen-list)
;; Add to seen list.
- (let* ((number-alist (elmo-msgdb-get-number-alist msgdb))
- (mark-alist (elmo-msgdb-get-mark-alist msgdb))
- ent)
+ (let (mark)
(while msgs
- (if (setq ent (assq (car msgs) mark-alist))
- (unless (member (cadr ent) unread-marks) ;; not unread mark
+ (if (setq mark (elmo-msgdb-get-mark msgdb (car msgs)))
+ (unless (member mark unread-marks) ;; not unread mark
(setq seen-list
- (cons (cdr (assq (car msgs) number-alist)) seen-list)))
+ (cons
+ (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
+ seen-list)))
;; no mark ... seen...
(setq seen-list
- (cons (cdr (assq (car msgs) number-alist)) seen-list)))
+ (cons
+ (elmo-msgdb-get-field msgdb (car msgs) 'message-id)
+ seen-list)))
(setq msgs (cdr msgs)))
seen-list))
(defun elmo-msgdb-get-message-id-from-buffer ()
- (or (elmo-field-body "message-id")
+ (let ((msgid (elmo-field-body "message-id")))
+ (if msgid
+ (if (string-match "<\\(.+\\)>$" msgid)
+ msgid
+ (concat "<" msgid ">")) ; Invaild message-id.
;; no message-id, so put dummy msgid.
- (concat (timezone-make-date-sortable
- (elmo-field-body "date"))
+ (concat "<" (timezone-make-date-sortable
+ (elmo-field-body "date"))
(nth 1 (eword-extract-address-components
- (or (elmo-field-body "from") "nobody"))))))
+ (or (elmo-field-body "from") "nobody"))) ">"))))
(defsubst elmo-msgdb-create-overview-from-buffer (number &optional size time)
"Create overview entity from current buffer.
Header region is supposed to be narrowed."
(save-excursion
(let ((extras elmo-msgdb-extra-fields)
+ (default-mime-charset default-mime-charset)
message-id references from subject to cc date
- extra field-body)
+ extra field-body charset)
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
(setq message-id (elmo-msgdb-get-message-id-from-buffer))
+ (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
+ (setq charset (intern-soft charset))
+ (setq default-mime-charset charset))
(setq references
(or (elmo-msgdb-get-last-message-id
(elmo-field-body "in-reply-to"))
(elmo-msgdb-get-last-message-id
(elmo-field-body "references"))))
- (setq from (elmo-mime-string (elmo-delete-char
- ?\"
- (or
- (elmo-field-body "from")
- elmo-no-from))))
- (setq subject (elmo-mime-string (or (elmo-field-body "subject")
- elmo-no-subject)))
+ (setq from (elmo-replace-in-string
+ (elmo-mime-string (or (elmo-field-body "from")
+ elmo-no-from))
+ "\t" " ")
+ subject (elmo-replace-in-string
+ (elmo-mime-string (or (elmo-field-body "subject")
+ elmo-no-subject))
+ "\t" " "))
(setq date (or (elmo-field-body "date") time))
(setq to (mapconcat 'identity (elmo-multiple-field-body "to") ","))
(setq cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
(cons (car entity)
(copy-sequence (cdr entity))))
-(static-if (boundp 'nemacs-version)
- (defsubst elmo-msgdb-insert-file-header (file)
- "Insert the header of the article (Does not work on nemacs)."
- (as-binary-input-file
- (insert-file-contents file)))
- (defsubst elmo-msgdb-insert-file-header (file)
- "Insert the header of the article."
- (let ((beg 0)
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- format-alist)
- (when (file-exists-p file)
- ;; Read until header separator is found.
- (while (and (eq elmo-msgdb-file-header-chop-length
- (nth 1
- (insert-file-contents-as-binary
- file nil beg
- (incf beg elmo-msgdb-file-header-chop-length))))
- (prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max)))))))))
+(defsubst elmo-msgdb-insert-file-header (file)
+ "Insert the header of the article."
+ (let ((beg 0)
+ insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook
+ format-alist)
+ (when (file-exists-p file)
+ ;; Read until header separator is found.
+ (while (and (eq elmo-msgdb-file-header-chop-length
+ (nth 1
+ (insert-file-contents-as-binary
+ file nil beg
+ (incf beg elmo-msgdb-file-header-chop-length))))
+ (prog1 (not (search-forward "\n\n" nil t))
+ (goto-char (point-max))))))))
(defsubst elmo-msgdb-create-overview-entity-from-file (number file)
(let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
(elmo-msgdb-overview-entity-get-date y)))
(error))))))
-(defun elmo-msgdb-sort-by-date (msgdb)
- (message "Sorting...")
- (let ((overview (elmo-msgdb-get-overview msgdb)))
- (setq overview (elmo-msgdb-overview-sort-by-date overview))
- (message "Sorting...done")
- (list overview (nth 1 msgdb)(nth 2 msgdb))))
-
-(defun elmo-msgdb-clear-overview-hashtb (entity hashtb)
- (let (number)
- (when (and entity
- elmo-use-overview-hashtb
- hashtb)
+(defun elmo-msgdb-clear-index (msgdb entity)
+ (let ((ehash (elmo-msgdb-get-entity-hashtb msgdb))
+ (mhash (elmo-msgdb-get-mark-hashtb msgdb))
+ number)
+ (when (and entity ehash)
(and (setq number (elmo-msgdb-overview-entity-get-number entity))
- (elmo-clear-hash-val (format "#%d" number) hashtb))
+ (elmo-clear-hash-val (format "#%d" number) ehash))
(and (car entity) ;; message-id
- (elmo-clear-hash-val (car entity) hashtb)))))
-
-(defun elmo-msgdb-make-overview-hashtb (overview &optional hashtb)
- (if (and elmo-use-overview-hashtb
- overview)
- (let ((hashtb (or hashtb ;; append
- (elmo-make-hash (length overview)))))
- (while overview
- ;; key is message-id
- (if (caar overview)
- (elmo-set-hash-val (caar overview) (car overview) hashtb))
- ;; key is number
- (elmo-set-hash-val
- (format "#%d" (elmo-msgdb-overview-entity-get-number (car overview)))
- (car overview) hashtb)
- (setq overview (cdr overview)))
- hashtb)
- nil))
-
-(defsubst elmo-msgdb-append (msgdb msgdb-append &optional set-hash)
- (list
- (nconc (car msgdb) (car msgdb-append))
- (nconc (cadr msgdb) (cadr msgdb-append))
- (nconc (caddr msgdb) (caddr msgdb-append))
- (and set-hash
- (elmo-msgdb-make-overview-hashtb (car msgdb-append) (nth 3 msgdb)))))
-
-(defsubst elmo-msgdb-clear (&optional msgdb)
- (if msgdb
- (list
- (setcar msgdb nil)
- (setcar (cdr msgdb) nil)
- (setcar (cddr msgdb) nil)
- (setcar (nthcdr 3 msgdb) (elmo-msgdb-make-overview-hashtb nil)))
- (list nil nil nil (elmo-msgdb-make-overview-hashtb nil))))
+ (elmo-clear-hash-val (car entity) ehash)))
+ (when (and entity mhash)
+ (and (setq number (elmo-msgdb-overview-entity-get-number entity))
+ (elmo-clear-hash-val (format "#%d" number) mhash)))))
+
+(defun elmo-msgdb-make-index (msgdb &optional overview mark-alist)
+ "Append OVERVIEW and MARK-ALIST to the index of MSGDB.
+If OVERVIEW and MARK-ALIST are nil, make index for current MSGDB.
+Return the updated INDEX."
+ (when msgdb
+ (let* ((overview (or overview (elmo-msgdb-get-overview msgdb)))
+ (mark-alist (or mark-alist (elmo-msgdb-get-mark-alist msgdb)))
+ (index (elmo-msgdb-get-index msgdb))
+ (ehash (or (car index) ;; append
+ (elmo-make-hash (length overview))))
+ (mhash (or (cdr index) ;; append
+ (elmo-make-hash (length overview)))))
+ (while overview
+ ;; key is message-id
+ (if (caar overview)
+ (elmo-set-hash-val (caar overview) (car overview) ehash))
+ ;; key is number
+ (elmo-set-hash-val
+ (format "#%d"
+ (elmo-msgdb-overview-entity-get-number (car overview)))
+ (car overview) ehash)
+ (setq overview (cdr overview)))
+ (while mark-alist
+ ;; key is number
+ (elmo-set-hash-val
+ (format "#%d" (car (car mark-alist)))
+ (car mark-alist) mhash)
+ (setq mark-alist (cdr mark-alist)))
+ (setq index (or index (cons ehash mhash)))
+ (elmo-msgdb-set-index msgdb index)
+ index)))
(defsubst elmo-folder-get-info (folder &optional hashtb)
(elmo-get-hash-val folder
(or hashtb elmo-folder-info-hashtb)))
-(defun elmo-folder-set-info-hashtb (folder max numbers &optional new unread)
- (let ((info (elmo-folder-get-info folder)))
- (when info
- (or new (setq new (nth 0 info)))
- (or unread (setq unread (nth 1 info)))
- (or numbers (setq numbers (nth 2 info)))
- (or max (setq max (nth 3 info))))
- (elmo-set-hash-val folder
- (list new unread numbers max)
- elmo-folder-info-hashtb)))
-
-(defun elmo-folder-set-info-max-by-numdb (folder msgdb-number)
- (let ((num-db (sort (mapcar 'car msgdb-number) '<)))
- (elmo-folder-set-info-hashtb
- folder
- (or (nth (max 0 (1- (length num-db))) num-db) 0)
- nil ;;(length num-db)
- )))
-
(defun elmo-folder-get-info-max (folder)
"Get folder info from cache."
(nth 3 (elmo-folder-get-info folder)))
(defun elmo-folder-get-info-unread (folder)
(nth 1 (elmo-folder-get-info folder)))
-(defun elmo-folder-info-make-hashtb (info-alist hashtb)
- (let* ((hashtb (or hashtb
- (elmo-make-hash (length info-alist)))))
- (mapcar
- '(lambda (x)
- (let ((info (cadr x)))
- (and (intern-soft (car x) hashtb)
- (elmo-set-hash-val (car x)
- (list (nth 2 info) ;; new
- (nth 3 info) ;; unread
- (nth 1 info) ;; length
- (nth 0 info)) ;; max
- hashtb))))
- info-alist)
- (setq elmo-folder-info-hashtb hashtb)))
-
(defsubst elmo-msgdb-location-load (dir)
(elmo-object-load
(expand-file-name
elmo-msgdb-location-filename
dir) alist))
+(put 'elmo-msgdb-do-each-entity 'lisp-indent-function '1)
+(def-edebug-spec elmo-msgdb-do-each-entity
+ ((symbolp form &rest form) &rest form))
+(defmacro elmo-msgdb-do-each-entity (spec &rest form)
+ `(dolist (,(car spec) (elmo-msgdb-get-overview ,(car (cdr spec))))
+ ,@form))
+
(require 'product)
(product-provide (provide 'elmo-msgdb) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff