From 9df2afe7ab9664f5d7ed1e6253ce93b5e3581b8d Mon Sep 17 00:00:00 2001 From: hmurata Date: Fri, 19 Sep 2003 19:46:39 +0000 Subject: [PATCH] * wl-score.el (wl-score-headers): Don't use 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 | 4 + WL-ELS | 2 +- elmo/ChangeLog | 11 ++ elmo/elmo-msgdb.el | 20 ++- elmo/elmo-vars.el | 9 + elmo/elmo.el | 6 +- elmo/modb-standard.el | 435 +++++++++++++++++++++++++++++++++++++++++++++++++ wl/ChangeLog | 3 + wl/wl-score.el | 6 +- 9 files changed, 489 insertions(+), 7 deletions(-) create mode 100644 elmo/modb-standard.el diff --git a/ChangeLog b/ChangeLog index c89cdb8..607a504 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2003-09-19 Hiroya Murata + + * WL-ELS (ELMO-MODULES): Added modb-standard. + 2003-09-18 Yuuichi Teranishi * WL-ELS (ELMO-MODULES): Removed elmo-mark and added elmo-flag. diff --git a/WL-ELS b/WL-ELS index 1ec7ce4..9b11151 100644 --- 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 )) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 8ad9e9e..3cdb373 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,16 @@ 2003-09-19 Hiroya Murata + * 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 diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index d9dbdbf..d33506b 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -82,12 +82,28 @@ ;; 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) diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index e2de650..3d98591 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -62,10 +62,19 @@ (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.") diff --git a/elmo/elmo.el b/elmo/elmo.el index 81c9ade..ef56069 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -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 index 0000000..9083717 --- /dev/null +++ b/elmo/modb-standard.el @@ -0,0 +1,435 @@ +;;; modb-standard.el --- Standartd Implement of MODB. + +;; Copyright (C) 2003 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; Hiroya Murata +;; 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 diff --git a/wl/ChangeLog b/wl/ChangeLog index 9b7fc07..b0b8b6b 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,8 @@ 2003-09-19 Hiroya Murata + * 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 diff --git a/wl/wl-score.el b/wl/wl-score.el index 20dd43c..2527b8c 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -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 -- 1.7.10.4