* wl-score.el (wl-score-headers): Don't use
authorhmurata <hmurata>
Fri, 19 Sep 2003 19:46:39 +0000 (19:46 +0000)
committerhmurata <hmurata>
Fri, 19 Sep 2003 19:46:39 +0000 (19:46 +0000)
elmo-folder-do-each-message-entity.

* modb-standard.el: New file.

* elmo.el (elmo-folder-clear): Reconstruct msgdb if
elmo-msgdb-convert-type is `sync'.

* elmo-vars.el (elmo-msgdb-default-type): Added `standard'.
(elmo-msgdb-convert-type): New user option.

* elmo-msgdb.el (elmo-msgdb-load-priorities): New internal variable.
(elmo-load-msgdb): Auto detect saved type.

* WL-ELS (ELMO-MODULES): Added modb-standard.

ChangeLog
WL-ELS
elmo/ChangeLog
elmo/elmo-msgdb.el
elmo/elmo-vars.el
elmo/elmo.el
elmo/modb-standard.el [new file with mode: 0644]
wl/ChangeLog
wl/wl-score.el

index c89cdb8..607a504 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2003-09-19  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * WL-ELS (ELMO-MODULES): Added modb-standard.
+
 2003-09-18  Yuuichi Teranishi  <teranisi@gohome.org>
 
        * WL-ELS (ELMO-MODULES): Removed elmo-mark and added elmo-flag.
diff --git a/WL-ELS b/WL-ELS
index 1ec7ce4..9b11151 100644 (file)
--- a/WL-ELS
+++ b/WL-ELS
@@ -22,7 +22,7 @@
    elmo-archive elmo-pipe elmo-cache
    elmo-internal elmo-flag elmo-sendlog
    elmo-dop elmo-nmz elmo-split
-   modb modb-entity modb-legacy
+   modb modb-entity modb-legacy modb-standard
    ))
 
 \f
index 8ad9e9e..3cdb373 100644 (file)
@@ -1,5 +1,16 @@
 2003-09-19  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
+       * modb-standard.el: New file.
+
+       * elmo.el (elmo-folder-clear): Reconstruct msgdb if
+       elmo-msgdb-convert-type is `sync'.
+
+       * elmo-vars.el (elmo-msgdb-default-type): Added `standard'.
+       (elmo-msgdb-convert-type): New user option.
+
+       * elmo-msgdb.el (elmo-msgdb-load-priorities): New internal variable.
+       (elmo-load-msgdb): Auto detect saved type.
+
        * elmo-version.el (elmo-version): Up to 2.11.15.
 
 2003-09-19  Yuuichi Teranishi  <teranisi@gohome.org>
index d9dbdbf..d33506b 100644 (file)
 ;; elmo-folder-get-info-length
 ;; elmo-folder-get-info-unread
 
+(defconst elmo-msgdb-load-priorities '(legacy standard)
+  "Priority list of modb type for load.")
+
 ;;; Helper functions for MSGDB
 ;;
 (defun elmo-load-msgdb (location)
   "Load the MSGDB from PATH."
-  (let ((msgdb (elmo-make-msgdb location)))
-    (elmo-msgdb-load msgdb)
+  (let ((msgdb (elmo-make-msgdb location elmo-msgdb-default-type))
+       priorities loaded temp-modb)
+    (unless (elmo-msgdb-load msgdb)
+      (setq priorities
+           (delq elmo-msgdb-default-type
+                 (copy-sequence elmo-msgdb-load-priorities)))
+      (while (and priorities
+                 (not loaded))
+       (setq temp-modb (elmo-make-msgdb location (car priorities))
+             loaded (elmo-msgdb-load temp-modb)
+             priorities (cdr priorities)))
+      (when loaded
+       (if (eq elmo-msgdb-convert-type 'auto)
+           (elmo-msgdb-append msgdb temp-modb)
+         (setq msgdb temp-modb))))
     msgdb))
 
 (defun elmo-make-msgdb (&optional location type)
index e2de650..3d98591 100644 (file)
 (defcustom elmo-msgdb-default-type 'legacy
   "*Default type of Message Database for ELMO."
   :type '(radio (const legacy)
+               (const standard)
                (const :tag "No use" generic))
   :group 'elmo
   :group 'elmo-setting)
 
+(defcustom elmo-msgdb-convert-type nil
+  "*MODB conversion type."
+  :type '(radio (const sync)
+               (const auto)
+               (const :tag "No convert" nil))
+  :group 'elmo
+  :group 'elmo-setting)
+
 (defvar elmo-msgdb-file-header-chop-length 2048
   "*Number of bytes to get header in one reading from file.")
 
index 81c9ade..ef56069 100644 (file)
@@ -1478,7 +1478,11 @@ FIELD is a symbol of the field.")
                                       &optional keep-killed)
   (unless keep-killed
     (elmo-folder-set-killed-list-internal folder nil))
-  (elmo-msgdb-clear (elmo-folder-msgdb folder)))
+  (if (eq elmo-msgdb-convert-type 'sync)
+      (elmo-folder-set-msgdb-internal
+       folder
+       (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
+    (elmo-msgdb-clear (elmo-folder-msgdb folder))))
 
 (luna-define-generic elmo-folder-synchronize (folder
                                              &optional
diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el
new file mode 100644 (file)
index 0000000..9083717
--- /dev/null
@@ -0,0 +1,435 @@
+;;; modb-standard.el --- Standartd Implement of MODB.
+
+;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;;     Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+;;; Code:
+;;
+(eval-when-compile (require 'cl))
+
+(require 'elmo-util)
+(require 'modb)
+(require 'modb-entity)
+
+
+(defcustom modb-standard-divide-number 500
+  "*Standard modb divide entity number."
+  :type '(choice (const :tag "Not divide" nil)
+                number)
+  :group 'elmo)
+
+(defvar modb-standard-entity-filename "entity"
+  "Message entity database.")
+
+(defvar modb-standard-flag-filename "flag"
+  "Message number <=> Flag status database.")
+
+(defvar modb-standard-msgid-filename "msgid"
+  "Message number <=> Message-Id database.")
+
+(eval-and-compile
+  (luna-define-class modb-standard (modb-generic)
+                    (number-list       ; sorted list of message numbers.
+                     entity-map        ; number, msg-id -> entity mapping.
+                     flag-map          ; number -> flag-list mapping
+                     ))
+  (luna-define-internal-accessors 'modb-standard))
+
+;; for internal use only
+(defsubst modb-standard-key (number)
+  (concat "#" (number-to-string number)))
+
+(defsubst modb-standard-entity-id (entity)
+  (if (eq 'autoload (car-safe entity))
+      (cddr entity)
+    (elmo-msgdb-overview-entity-get-id entity)))
+
+(defsubst modb-standard-entity-map (modb)
+  (or (modb-standard-entity-map-internal modb)
+      (modb-standard-set-entity-map-internal
+       modb
+       (elmo-make-hash (elmo-msgdb-length modb)))))
+
+(defsubst modb-standard-flag-map (modb)
+  (or (modb-standard-flag-map-internal modb)
+      (modb-standard-set-flag-map-internal
+       modb
+       (elmo-make-hash (elmo-msgdb-length modb)))))
+
+(defsubst modb-standard-set-message-modified (modb number)
+  (if modb-standard-divide-number
+      (let ((section (/ number modb-standard-divide-number))
+           (modified (modb-generic-message-modified-internal modb)))
+       (unless (memq section modified)
+         (modb-generic-set-message-modified-internal
+          modb (cons section modified))))
+    (modb-generic-set-message-modified-internal modb t)))
+
+(defsubst modb-standard-set-flag-modified (modb number)
+  (modb-generic-set-flag-modified-internal modb t))
+
+(defsubst modb-standard-message-flags (modb number)
+  (cdr (elmo-get-hash-val (modb-standard-key number)
+                         (modb-standard-flag-map-internal modb))))
+
+(defsubst modb-standard-match-flags (check-flags flags)
+  (catch 'done
+    (while check-flags
+      (when (memq (car check-flags) flags)
+       (throw 'done t))
+      (setq check-flags (cdr check-flags)))))
+
+
+;; save and load functions
+(defun modb-standard-load-msgid (modb path)
+  (let* ((alist (elmo-object-load
+                (expand-file-name modb-standard-msgid-filename path)))
+        (table (or (modb-standard-entity-map-internal modb)
+                   (elmo-make-hash (length alist))))
+        numbers info)
+    (dolist (pair alist)
+      (setq info (cons 'autoload pair))
+      (elmo-set-hash-val (modb-standard-key (car pair)) info table)
+      (elmo-set-hash-val (cdr pair) info table)
+      (setq numbers (cons (car pair) numbers)))
+    (modb-standard-set-number-list-internal modb (nreverse numbers))
+    (modb-standard-set-entity-map-internal modb table)))
+
+(defun modb-standard-save-msgid (modb path)
+  (let ((table (modb-standard-entity-map-internal modb))
+       entity alist)
+    (dolist (number (modb-standard-number-list-internal modb))
+      (setq entity (elmo-get-hash-val (modb-standard-key number) table))
+      (setq alist (cons (cons number (modb-standard-entity-id entity))
+                       alist)))
+    (elmo-object-save
+     (expand-file-name modb-standard-msgid-filename path)
+     (nreverse alist))))
+
+(defun modb-standard-load-flag (modb path)
+  (let ((table (or (modb-standard-flag-map-internal modb)
+                  (elmo-make-hash (elmo-msgdb-length modb)))))
+    (dolist (info (elmo-object-load
+                  (expand-file-name modb-standard-flag-filename path)))
+      (elmo-set-hash-val (modb-standard-key (car info)) info table))
+    (modb-standard-set-flag-map-internal modb table)))
+
+(defun modb-standard-save-flag (modb path)
+  (let (table flist info)
+    (when (setq table (modb-standard-flag-map-internal modb))
+      (mapatoms
+       (lambda (atom)
+        (setq info (symbol-value atom))
+        (when (cdr info)
+          (setq flist (cons info flist))))
+       table))
+    (elmo-object-save
+     (expand-file-name modb-standard-flag-filename path)
+     flist)))
+
+(defsubst modb-standard-entity-filename (section)
+  (if section
+      (concat modb-standard-entity-filename
+             "-"
+             (number-to-string section))
+    modb-standard-entity-filename))
+
+(defun modb-standard-load-entity (modb path &optional section)
+  (let ((table (or (modb-standard-entity-map-internal modb)
+                  (elmo-make-hash (elmo-msgdb-length modb)))))
+    (dolist (entity (elmo-object-load
+                    (expand-file-name
+                     (modb-standard-entity-filename section)
+                     path)))
+      (elmo-set-hash-val (modb-standard-key
+                         (elmo-msgdb-overview-entity-get-number entity))
+                        entity
+                        table)
+      (elmo-set-hash-val (elmo-msgdb-overview-entity-get-id entity)
+                        entity
+                        table))
+    (modb-standard-set-entity-map-internal modb table)))
+
+(defsubst modb-standard-save-entity-1 (modb path &optional section)
+  (let ((table (modb-standard-entity-map-internal modb))
+       (filename (expand-file-name
+                  (modb-standard-entity-filename section) path))
+       entity entities)
+    (dolist (number (modb-standard-number-list-internal modb))
+      (when (and (or (null section)
+                    (= section (/ number modb-standard-divide-number)))
+                (setq entity (elmo-msgdb-message-entity modb number)))
+       (setq entities (cons entity entities))))
+    (if entities
+       (elmo-object-save filename entities)
+      (ignore-errors (delete-file filename)))))
+
+(defun modb-standard-save-entity (modb path)
+  (let ((sections (modb-generic-message-modified-internal modb)))
+    (cond ((listp sections)
+          (dolist (section sections)
+            (modb-standard-save-entity-1 modb path section)))
+         (sections
+          (modb-standard-save-entity-1 modb path)))))
+
+;;; Implement
+;;
+(luna-define-method elmo-msgdb-load ((msgdb modb-standard))
+  (let ((inhibit-quit t)
+       (path (elmo-msgdb-location msgdb)))
+    (when (file-exists-p (expand-file-name modb-standard-flag-filename path))
+      (modb-standard-load-msgid msgdb path)
+      (modb-standard-load-flag msgdb path)
+      (unless modb-standard-divide-number
+       (modb-standard-load-entity msgdb path))
+      t)))
+
+(luna-define-method elmo-msgdb-save ((msgdb modb-standard))
+  (let ((path (elmo-msgdb-location msgdb)))
+    (when (elmo-msgdb-message-modified-p msgdb)
+      (modb-standard-save-msgid  msgdb path)
+      (modb-standard-save-entity msgdb path)
+      (modb-generic-set-message-modified-internal msgdb nil))
+    (when (elmo-msgdb-flag-modified-p msgdb)
+      (modb-standard-save-flag msgdb path)
+      (modb-generic-set-flag-modified-internal msgdb nil))))
+
+(luna-define-method elmo-msgdb-append :around ((msgdb modb-standard)
+                                              msgdb-append)
+  (when (> (elmo-msgdb-length msgdb-append) 0)
+    (if (eq (luna-class-name msgdb-append) 'modb-standard)
+       (let ((numbers (modb-standard-number-list-internal msgdb-append))
+             duplicates)
+         ;; number-list
+         (modb-standard-set-number-list-internal
+          msgdb
+          (nconc (modb-standard-number-list-internal msgdb)
+                 numbers))
+         ;; entity-map
+         (let ((table (modb-standard-entity-map msgdb))
+               entity msg-id)
+           (dolist (number numbers)
+             (setq entity (elmo-msgdb-message-entity msgdb-append number)
+                   msg-id (modb-standard-entity-id entity))
+             (if (elmo-get-hash-val msg-id table)
+                 (setq duplicates (cons number duplicates))
+               (elmo-set-hash-val msg-id entity table))
+             (elmo-set-hash-val (modb-standard-key number)
+                                entity
+                                table)))
+         ;; flag-map
+         (let ((table (modb-standard-flag-map msgdb)))
+           (mapatoms
+            (lambda (atom)
+              (elmo-set-hash-val (symbol-name atom)
+                                 (symbol-value atom)
+                                 table))
+            (modb-standard-flag-map msgdb-append)))
+         ;; modification flags
+         (dolist (number (modb-standard-number-list-internal msgdb-append))
+           (modb-standard-set-message-modified msgdb number)
+           (modb-standard-set-flag-modified msgdb number))
+         duplicates)
+      (luna-call-next-method))))
+
+(luna-define-method elmo-msgdb-clear :after ((msgdb modb-standard))
+  (modb-standard-set-number-list-internal msgdb nil)
+  (modb-standard-set-entity-map-internal msgdb nil)
+  (modb-standard-set-flag-map-internal msgdb nil))
+
+(luna-define-method elmo-msgdb-length ((msgdb modb-standard))
+  (length (modb-standard-number-list-internal msgdb)))
+
+(luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
+  (modb-standard-message-flags msgdb number))
+
+(luna-define-method elmo-msgdb-set-flag ((msgdb modb-standard)
+                                        number flag)
+  (case flag
+    (read
+     (elmo-msgdb-unset-flag msgdb number 'unread))
+    (uncached
+     (elmo-msgdb-unset-flag msgdb number 'cached))
+    (t
+     (let* ((cur-flags (modb-standard-message-flags msgdb number))
+           (new-flags (copy-sequence cur-flags)))
+       (and (memq 'new new-flags)
+           (setq new-flags (delq 'new new-flags)))
+       (or (memq flag new-flags)
+          (setq new-flags (cons flag new-flags)))
+       (when (and (eq flag 'unread)
+                 (memq 'answered new-flags))
+        (setq new-flags (delq 'answered new-flags)))
+       (unless (equal new-flags cur-flags)
+        (elmo-set-hash-val (modb-standard-key number)
+                           (cons number new-flags)
+                           (modb-standard-flag-map msgdb))
+        (modb-standard-set-flag-modified msgdb number))))))
+
+(luna-define-method elmo-msgdb-unset-flag ((msgdb modb-standard)
+                                          number flag)
+  (case flag
+    (read
+     (elmo-msgdb-set-flag msgdb number 'unread))
+    (uncached
+     (elmo-msgdb-set-flag msgdb number 'cached))
+    (t
+     (let* ((cur-flags (modb-standard-message-flags msgdb number))
+           (new-flags (copy-sequence cur-flags)))
+       (and (memq 'new new-flags)
+           (setq new-flags (delq 'new new-flags)))
+       (and (memq flag new-flags)
+           (setq new-flags (delq flag new-flags)))
+       (when (and (eq flag 'unread)
+                 (memq 'answered new-flags))
+        (setq new-flags (delq 'answered new-flags)))
+       (unless (equal new-flags cur-flags)
+        (elmo-set-hash-val (modb-standard-key number)
+                           (cons number new-flags)
+                           (modb-standard-flag-map msgdb))
+        (modb-standard-set-flag-modified msgdb number))))))
+
+(luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
+  (copy-sequence
+   (modb-standard-number-list-internal msgdb)))
+
+(luna-define-method elmo-msgdb-list-flagged ((msgdb modb-standard) flag)
+  (let (entry matched)
+    (case flag
+      (read
+       (dolist (number (modb-standard-number-list-internal msgdb))
+        (unless (memq 'unread (modb-standard-message-flags msgdb number))
+          (setq matched (cons number matched)))))
+      (digest
+       (mapatoms
+       (lambda (atom)
+         (setq entry (symbol-value atom))
+         (when (modb-standard-match-flags '(unread important)
+                                          (cdr entry))
+           (setq matched (cons (car entry) matched))))
+       (modb-standard-flag-map msgdb)))
+      (any
+       (mapatoms
+       (lambda (atom)
+         (setq entry (symbol-value atom))
+         (when (modb-standard-match-flags '(unread important answered)
+                                          (cdr entry))
+           (setq matched (cons (car entry) matched))))
+       (modb-standard-flag-map msgdb)))
+      (t
+       (mapatoms
+       (lambda (atom)
+         (setq entry (symbol-value atom))
+         (when (memq flag (cdr entry))
+           (setq matched (cons (car entry) matched))))
+       (modb-standard-flag-map msgdb))))
+    matched))
+
+(luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
+                                             entity &optional flags)
+  (let ((number (elmo-msgdb-overview-entity-get-number entity))
+       (msg-id (elmo-msgdb-overview-entity-get-id entity))
+       duplicate)
+    ;; number-list
+    (modb-standard-set-number-list-internal
+     msgdb
+     (nconc (modb-standard-number-list-internal msgdb)
+           (list number)))
+    ;; entity-map
+    (let ((table (modb-standard-entity-map msgdb)))
+      (setq duplicate (elmo-get-hash-val msg-id table))
+      (elmo-set-hash-val (modb-standard-key number) entity table)
+      (elmo-set-hash-val msg-id entity table))
+    ;; modification flags
+    (modb-standard-set-message-modified msgdb number)
+    ;; flag-map
+    (when flags
+      (elmo-set-hash-val
+       (modb-standard-key number)
+       (cons number flags)
+       (modb-standard-flag-map msgdb))
+      (modb-standard-set-flag-modified msgdb number))
+    duplicate))
+
+(luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
+                                               numbers)
+  (let ((number-list (modb-standard-number-list-internal msgdb))
+       (entity-map (modb-standard-entity-map-internal msgdb))
+       (flag-map (modb-standard-flag-map-internal msgdb))
+       key entity)
+    (dolist (number numbers)
+      (setq key (modb-standard-key number)
+           entity (elmo-get-hash-val key entity-map))
+      ;; number-list
+      (setq number-list (delq number number-list))
+      ;; entity-map
+      (elmo-clear-hash-val key entity-map)
+      (elmo-clear-hash-val (modb-standard-entity-id entity) entity-map)
+      ;; flag-map
+      (elmo-clear-hash-val key flag-map)
+      (modb-standard-set-message-modified msgdb number)
+      (modb-standard-set-flag-modified msgdb number))
+    (modb-standard-set-number-list-internal msgdb number-list)
+    (modb-standard-set-entity-map-internal msgdb entity-map)
+    (modb-standard-set-flag-map-internal msgdb flag-map)))
+
+(luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
+                                             predicate &optional app-data)
+  (message "Sorting...")
+  (let ((numbers (modb-standard-number-list-internal msgdb)))
+    (modb-standard-set-number-list-internal
+     msgdb
+     (sort numbers (lambda (a b)
+                    (funcall predicate
+                             (elmo-msgdb-message-entity msgdb a)
+                             (elmo-msgdb-message-entity msgdb b)
+                             app-data))))
+    (message "Sorting...done")
+    msgdb))
+
+(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
+  (let ((ret (elmo-get-hash-val
+             (cond ((stringp key) key)
+                   ((numberp key) (modb-standard-key key)))
+             (modb-standard-entity-map-internal msgdb))))
+    (if (eq 'autoload (car-safe ret))
+       (when modb-standard-divide-number
+         (modb-standard-load-entity
+          msgdb
+          (elmo-msgdb-location msgdb)
+          (/ (nth 1 ret) modb-standard-divide-number))
+         (elmo-get-hash-val
+          (cond ((stringp key) key)
+                ((numberp key) (modb-standard-key key)))
+          (modb-standard-entity-map-internal msgdb)))
+      ret)))
+
+
+(require 'product)
+(product-provide (provide 'modb-standard) (require 'elmo-version))
+
+;;; modb-standard.el ends here
index 9b7fc07..b0b8b6b 100644 (file)
@@ -1,5 +1,8 @@
 2003-09-19  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
+       * wl-score.el (wl-score-headers): Don't use
+       elmo-folder-do-each-message-entity.
+
        * Version number is increased to 2.11.15.
 
 2003-09-19  Yuuichi Teranishi  <teranisi@gohome.org>
index 20dd43c..2527b8c 100644 (file)
@@ -403,14 +403,14 @@ Set `wl-score-cache' nil."
     (message "Scoring...")
 
     ;; Create messages, an alist of the form `(ENTITY . SCORE)'.
-    (elmo-folder-do-each-message-entity (entity folder)
-      (setq num (elmo-message-entity-number entity))
+    (dolist (num (elmo-folder-list-messages folder 'visible 'in-db))
       (when (and (not (assq num wl-summary-scored))
                 (or (memq num force-msgs)
                     (member (wl-summary-message-mark folder num)
                             wl-summary-score-marks)))
        (setq wl-scores-messages
-             (cons (cons entity (or wl-summary-default-score 0))
+             (cons (cons (elmo-message-entity folder num)
+                         (or wl-summary-default-score 0))
                    wl-scores-messages))))
 
     (save-excursion