X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-msgdb.el;h=7364c5cee4a176616724f02672039be89cff80f7;hb=40f5de1a09510d7a28ecc0bef4fea09b5845511f;hp=1504237bbab6c14db24f1d96eae22b3d2f4649e6;hpb=8b003dd16e3d4a1f0d29b5fcd0f57a2ee294f967;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 1504237..7364c5c 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -1,4 +1,4 @@ -;;; elmo-msgdb.el -- Message Database for Elmo. +;;; elmo-msgdb.el --- Message Database for ELMO. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 2000 Masahiro MURATA @@ -26,17 +26,154 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (eval-when-compile (require 'cl)) (require 'elmo-vars) (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)) @@ -52,9 +189,16 @@ (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 ;; @@ -73,7 +217,7 @@ (defun elmo-msgdb-global-mark-delete (msgid) (let* ((path (expand-file-name elmo-msgdb-global-mark-filename - elmo-msgdb-dir)) + elmo-msgdb-directory)) (malist (or elmo-msgdb-global-mark-alist (setq elmo-msgdb-global-mark-alist (elmo-object-load path)))) @@ -86,7 +230,7 @@ (defun elmo-msgdb-global-mark-set (msgid mark) (let* ((path (expand-file-name elmo-msgdb-global-mark-filename - elmo-msgdb-dir)) + elmo-msgdb-directory)) (malist (or elmo-msgdb-global-mark-alist (setq elmo-msgdb-global-mark-alist (elmo-object-load path)))) @@ -104,12 +248,12 @@ (elmo-object-load (expand-file-name elmo-msgdb-global-mark-filename - elmo-msgdb-dir))))))) + elmo-msgdb-directory))))))) ;;; ;; 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)) @@ -119,9 +263,12 @@ (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) @@ -129,18 +276,23 @@ (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 @@ -274,102 +426,104 @@ header separator." (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)) @@ -380,15 +534,27 @@ content of MSGDB is changed." (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))) +(defsubst elmo-msgdb-overview-entity-set-references (entity references) + (and entity (aset (cdr entity) 1 references)) + entity) + ;; entity -> parent-entity (defsubst elmo-msgdb-overview-get-parent-entity (entity database) (setq entity (elmo-msgdb-overview-entity-get-references entity)) ;; 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))) @@ -424,6 +590,10 @@ content of MSGDB is changed." (defsubst elmo-msgdb-overview-entity-get-date (entity) (and entity (aref (cdr entity) 4))) +(defsubst elmo-msgdb-overview-entity-set-date (entity date) + (and entity (aset (cdr entity) 4 date)) + entity) + (defsubst elmo-msgdb-overview-entity-get-to (entity) (and entity (aref (cdr entity) 5))) @@ -445,6 +615,15 @@ content of MSGDB is changed." (and extra (cdr (assoc field-name extra))))) +(defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value) + (let ((extras (and entity (aref (cdr entity) 8))) + extra) + (if (setq extra (assoc field-name extras)) + (setcdr extra value) + (elmo-msgdb-overview-entity-set-extra + entity + (cons (cons field-name value) extras))))) + (defsubst elmo-msgdb-overview-entity-get-extra (entity) (and entity (aref (cdr entity) 8))) @@ -465,21 +644,11 @@ content of MSGDB is changed." (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 @@ -543,13 +712,13 @@ content of MSGDB is changed." (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) @@ -557,7 +726,7 @@ content of MSGDB is changed." 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) @@ -565,66 +734,77 @@ content of MSGDB is changed." 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") ",")) @@ -646,26 +826,21 @@ Header region is supposed to be narrowed." (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... @@ -690,7 +865,7 @@ Header region is supposed to be narrowed." (point-max))) (narrow-to-region (point-min) header-end) (elmo-msgdb-create-overview-from-buffer number size mtime)))))) - + (defun elmo-msgdb-overview-sort-by-date (overview) (sort overview (function @@ -703,80 +878,55 @@ Header region is supposed to be narrowed." (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))) @@ -787,22 +937,6 @@ Header region is supposed to be narrowed." (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 @@ -821,6 +955,13 @@ Header region is supposed to be narrowed." 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))