X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Fmodb-standard.el;h=46e4b6179157d155be6439e192e1277df84f985d;hb=6444631eeac4bef1933e27202080f62ac536aada;hp=984bf23f0e1b021ab02c0525b337d16ed9dda1fe;hpb=aeafc826de87afdfb39a5b9181c147a7ddf3bbeb;p=elisp%2Fwanderlust.git

diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el
index 984bf23..46e4b61 100644
--- a/elmo/modb-standard.el
+++ b/elmo/modb-standard.el
@@ -32,7 +32,6 @@
 (eval-when-compile (require 'cl))
 
 (require 'elmo-util)
-(require 'mime)
 (require 'modb)
 
 (defcustom modb-standard-divide-number 500
@@ -41,6 +40,12 @@
 		 number)
   :group 'elmo)
 
+(defcustom modb-standard-economize-entity-size t
+  "*Economize message entity size.
+When non-nil, redundunt message-id string are not saved."
+  :type 'boolean
+  :group 'elmo)
+
 (defvar modb-standard-entity-filename "entity"
   "Message entity database.")
 
@@ -55,6 +60,7 @@
 		     (number-list	; sorted list of message numbers.
 		      entity-map	; number, msg-id -> entity mapping.
 		      flag-map		; number -> flag-list mapping
+		      flag-count	; list of (FLAG . COUNT)
 		      ))
   (luna-define-internal-accessors 'modb-standard))
 
@@ -66,7 +72,7 @@
   (if (eq 'autoload (car-safe entity))
       (cddr entity)
     (elmo-msgdb-message-entity-field
-     (elmo-message-entity-db entity)
+     (elmo-message-entity-handler entity)
      entity 'message-id)))
 
 (defsubst modb-standard-entity-map (modb)
@@ -104,6 +110,15 @@
 	(throw 'done t))
       (setq check-flags (cdr check-flags)))))
 
+(defsubst modb-standard-countup-flags (modb flags &optional delta)
+  (let ((flag-count (modb-standard-flag-count-internal modb))
+	(delta (or delta 1))
+	elem)
+    (dolist (flag flags)
+      (if (setq elem (assq flag flag-count))
+	  (setcdr elem (+ (cdr elem) delta))
+	(setq flag-count (cons (cons flag delta) flag-count))))
+    (modb-standard-set-flag-count-internal modb flag-count)))
 
 ;; save and load functions
 (defun modb-standard-load-msgid (modb path)
@@ -136,6 +151,7 @@
 		   (elmo-make-hash (elmo-msgdb-length modb)))))
     (dolist (info (elmo-object-load
 		   (expand-file-name modb-standard-flag-filename path)))
+      (modb-standard-countup-flags modb (cdr info))
       (elmo-set-hash-val (modb-standard-key (car info)) info table))
     (modb-standard-set-flag-map-internal modb table)))
 
@@ -159,24 +175,40 @@
 	      (number-to-string section))
     modb-standard-entity-filename))
 
+(defsubst modb-standard-loaded-message-id (msgdb number)
+  "Get message-id for autoloaded entity."
+  (let ((ret (elmo-get-hash-val
+	      (modb-standard-key number)
+	      (modb-standard-entity-map-internal msgdb))))
+    (cond
+     ((and ret (eq (car-safe ret) 'autoload))
+      (cdr (cdr ret))) ; message-id.
+     ((and ret (stringp (car-safe ret)))
+      ;; Already loaded.
+      (car ret))
+     ((null ret)
+      ;; Garbage entity.
+      (elmo-clear-hash-val (modb-standard-key number)
+			   (modb-standard-entity-map-internal msgdb))
+      nil)				; return nil.
+     (t (error "Internal error: invalid msgdb status")))))
+
 (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)))))
+		   (elmo-make-hash (elmo-msgdb-length modb))))
+	number msgid)
     (dolist (entity (elmo-object-load
 		     (expand-file-name
 		      (modb-standard-entity-filename section)
 		      path)))
-      (elmo-set-hash-val (modb-standard-key
-			  (elmo-msgdb-message-entity-number
-			   (elmo-message-entity-db entity)
-			   entity))
-			 entity
-			 table)
-      (elmo-set-hash-val (elmo-msgdb-message-entity-field
-			  (elmo-message-entity-db entity)
-			  entity 'message-id)
-			 entity
-			 table))
+      (setq number (elmo-msgdb-message-entity-number
+		    (elmo-message-entity-handler entity)
+		    entity)
+	    msgid (modb-standard-loaded-message-id modb number))
+      (when msgid
+	(setcar entity msgid)
+	(elmo-set-hash-val msgid entity table)
+	(elmo-set-hash-val (modb-standard-key number) entity table)))
     (modb-standard-set-entity-map-internal modb table)))
 
 (defsubst modb-standard-save-entity-1 (modb path &optional section)
@@ -188,6 +220,9 @@
       (when (and (or (null section)
 		     (= section (/ number modb-standard-divide-number)))
 		 (setq entity (elmo-msgdb-message-entity modb number)))
+	(when modb-standard-economize-entity-size
+	  (when (stringp (car entity))
+	    (setq entity (cons t (cdr entity)))))
 	(setq entities (cons entity entities))))
     (if entities
 	(elmo-object-save filename entities)
@@ -214,7 +249,8 @@
       t)))
 
 (luna-define-method elmo-msgdb-save ((msgdb modb-standard))
-  (let ((path (elmo-msgdb-location msgdb)))
+  (let ((path (elmo-msgdb-location msgdb))
+	(inhibit-quit t))
     (when (elmo-msgdb-message-modified-p msgdb)
       (modb-standard-save-msgid  msgdb path)
       (modb-standard-save-entity msgdb path)
@@ -254,6 +290,9 @@
 				  (symbol-value atom)
 				  table))
 	     (modb-standard-flag-map msgdb-append)))
+	  ;; flag-count
+	  (dolist (pair (modb-standard-flag-count-internal msgdb-append))
+	    (modb-standard-countup-flags msgdb (list (car pair)) (cdr pair)))
 	  ;; modification flags
 	  (dolist (number (modb-standard-number-list-internal msgdb-append))
 	    (modb-standard-set-message-modified msgdb number)
@@ -264,11 +303,15 @@
 (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))
+  (modb-standard-set-flag-map-internal msgdb nil)
+  (modb-standard-set-flag-count-internal msgdb nil))
 
 (luna-define-method elmo-msgdb-length ((msgdb modb-standard))
   (length (modb-standard-number-list-internal msgdb)))
 
+(luna-define-method elmo-msgdb-flag-available-p ((msgdb modb-standard) flag)
+  t)
+
 (luna-define-method elmo-msgdb-flags ((msgdb modb-standard) number)
   (modb-standard-message-flags msgdb number))
 
@@ -280,16 +323,13 @@
     (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)
+     (let ((cur-flags (modb-standard-message-flags msgdb number))
+	   new-flags diff)
+       (unless (memq flag cur-flags)
+	 (setq new-flags (cons flag cur-flags))
+	 (setq diff (elmo-list-diff-nonsortable new-flags cur-flags))
+	 (modb-standard-countup-flags msgdb (car diff))
+	 (modb-standard-countup-flags msgdb (cadr diff) -1)
 	 (elmo-set-hash-val (modb-standard-key number)
 			    (cons number new-flags)
 			    (modb-standard-flag-map msgdb))
@@ -302,21 +342,30 @@
      (elmo-msgdb-set-flag msgdb number 'unread))
     (uncached
      (elmo-msgdb-set-flag msgdb number 'cached))
+    (all
+     (modb-standard-countup-flags msgdb
+				  (modb-standard-message-flags msgdb number)
+				  -1)
+     (elmo-clear-hash-val (modb-standard-key number)
+			  (modb-standard-flag-map msgdb)))
     (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)
+     (let ((cur-flags (modb-standard-message-flags msgdb number))
+	   (inhibit-quit t)
+	   new-flags diff)
+       (when (memq flag cur-flags)
+	 (setq new-flags (delq flag (copy-sequence cur-flags)))
+	 (setq diff (elmo-list-diff-nonsortable new-flags cur-flags))
+	 (modb-standard-countup-flags msgdb (car diff))
+	 (modb-standard-countup-flags msgdb (cadr diff) -1)
 	 (elmo-set-hash-val (modb-standard-key number)
 			    (cons number new-flags)
 			    (modb-standard-flag-map msgdb))
-	 (modb-standard-set-flag-modified msgdb number))))))
+	 (modb-standard-set-flag-modified msgdb number))
+       (when (eq flag 'unread)
+	 (elmo-msgdb-unset-flag msgdb number 'new))))))
+
+(luna-define-method elmo-msgdb-flag-count ((msgdb modb-standard))
+  (modb-standard-flag-count-internal msgdb))
 
 (luna-define-method elmo-msgdb-list-messages ((msgdb modb-standard))
   (copy-sequence
@@ -329,22 +378,29 @@
        (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)))
+      (uncached
+       (dolist (number (modb-standard-number-list-internal msgdb))
+	 (unless (memq 'cached (modb-standard-message-flags msgdb number))
+	   (setq matched (cons number matched)))))
       (any
        (mapatoms
 	(lambda (atom)
 	  (setq entry (symbol-value atom))
-	  (when (modb-standard-match-flags '(unread important answered)
-					   (cdr entry))
+	  (unless (and (eq (length (cdr entry)) 1)
+		       (eq (car (cdr entry)) 'cached))
+	    ;; If there is a flag other than cached, then the message
+	    ;; matches to `any'.
 	    (setq matched (cons (car entry) matched))))
 	(modb-standard-flag-map msgdb)))
+      (digest
+       (let ((flags (append elmo-digest-flags
+			    (elmo-get-global-flags t t))))
+	 (mapatoms
+	  (lambda (atom)
+	    (setq entry (symbol-value atom))
+	    (when (modb-standard-match-flags flags (cdr entry))
+	      (setq matched (cons (car entry) matched))))
+	  (modb-standard-flag-map msgdb))))
       (t
        (mapatoms
 	(lambda (atom)
@@ -354,33 +410,80 @@
 	(modb-standard-flag-map msgdb))))
     matched))
 
+(luna-define-method elmo-msgdb-search ((msgdb modb-standard)
+				       condition &optional numbers)
+  (if (vectorp condition)
+      (let ((key (elmo-filter-key condition))
+	    results)
+	(cond
+	 ((and (string= key "flag")
+	       (eq (elmo-filter-type condition) 'match))
+	  (setq results (elmo-msgdb-list-flagged
+			 msgdb
+			 (intern (elmo-filter-value condition))))
+	  (if numbers
+	      (elmo-list-filter numbers results)
+	    results))
+	 ((member key '("first" "last"))
+	  (let* ((numbers (or numbers
+			      (modb-standard-number-list-internal msgdb)))
+		 (len (length numbers))
+		 (lastp (string= key "last"))
+		 (value (string-to-number (elmo-filter-value condition))))
+	    (when (eq (elmo-filter-type condition) 'unmatch)
+	      (setq lastp (not lastp)
+		    value (- len value)))
+	    (if lastp
+		(nthcdr (max (- len value) 0) numbers)
+	      (when (> value 0)
+		(let* ((numbers (copy-sequence numbers))
+		       (last (nthcdr (1- value) numbers)))
+		  (when last
+		    (setcdr last nil))
+		  numbers)))))
+	 (t
+	  t)))
+    t))
+
 (luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
 					      entity &optional flags)
-  (let ((number (elmo-msgdb-message-entity-number
-		 (elmo-message-entity-db entity) entity))
-	(msg-id (elmo-msgdb-message-entity-field
-		 (elmo-message-entity-db entity) entity 'message-id))
-	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))
+  (when entity
+    (let ((number (elmo-msgdb-message-entity-number
+		   (elmo-message-entity-handler entity) entity))
+	  (msg-id (elmo-msgdb-message-entity-field
+		   (elmo-message-entity-handler entity) entity 'message-id))
+	  duplicate)
+      (when msg-id
+	;; 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-countup-flags msgdb flags)
+	  (modb-standard-set-flag-modified msgdb number))
+	duplicate))))
+
+(luna-define-method elmo-msgdb-update-entity ((msgdb modb-standard)
+					      entity values)
+  (let ((handler (elmo-message-entity-handler entity)))
+    (when (elmo-msgdb-message-entity-update-fields handler entity values)
+      (modb-standard-set-message-modified
+       msgdb
+       (elmo-msgdb-message-entity-number handler entity))
+      t)))
 
 (luna-define-method elmo-msgdb-delete-messages ((msgdb modb-standard)
 						numbers)
@@ -391,18 +494,25 @@
     (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))
+      (when entity
+	;; 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-count (must be BEFORE flag-map)
+	(modb-standard-countup-flags
+	 msgdb
+	 (modb-standard-message-flags msgdb number)
+	 -1)
+	;; 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)))
+    (modb-standard-set-flag-map-internal msgdb flag-map)
+    t))
 
 (luna-define-method elmo-msgdb-sort-entities ((msgdb modb-standard)
 					      predicate &optional app-data)
@@ -418,122 +528,49 @@
     (message "Sorting...done")
     msgdb))
 
-(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
+(defun modb-standard-message-entity (msgdb key load)
   (let ((ret (elmo-get-hash-val
-	      (cond ((stringp key) key)
-		    ((numberp key) (modb-standard-key key)))
-	      (modb-standard-entity-map-internal msgdb))))
+	      key
+	      (modb-standard-entity-map-internal msgdb)))
+	(inhibit-quit t))
     (if (eq 'autoload (car-safe ret))
-	(when modb-standard-divide-number
+	(when (and load 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)))
+	  (modb-standard-message-entity msgdb key nil))
       ret)))
 
-;;; Message entity handling.
-(defsubst modb-standard-make-message-entity (args)
-  "Make an message 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))))
-
-(luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-standard)
-						    args)
-  (modb-standard-make-message-entity args))
-
-(luna-define-method elmo-msgdb-create-message-entity-from-buffer
-  ((msgdb modb-standard) number args)
-  (let ((extras elmo-msgdb-extra-fields)
-	(default-mime-charset default-mime-charset)
-	entity message-id references from subject to cc date
-	extra field-body charset size)
-    (save-excursion
-      (setq entity (modb-standard-make-message-entity args)
-	    ;; For compatibility.
-	    msgdb (elmo-message-entity-db entity))
-      (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")))
-	    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" " ")
-	    date (elmo-field-body "date")
-	    to   (mapconcat 'identity (elmo-multiple-field-body "to") ",")
-	    cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
-      (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
-	(if (setq size (elmo-field-body "content-length"))
-	    (setq size (string-to-int size))
-	  (setq size 0)))
-      (while extras
-	(if (setq field-body (elmo-field-body (car extras)))
-	    (elmo-msgdb-message-entity-set-field
-	     msgdb entity (intern (downcase (car extras))) field-body))
-	(setq extras (cdr extras)))
-      (dolist (field '(number message-id references from subject
-			      date to cc size))
-	(when (symbol-value field)
-	  (elmo-msgdb-message-entity-set-field
-	   msgdb entity field (symbol-value field))))
-      entity)))
-
-;;; Message entity interface
-;;
-(luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-standard)
-						      entity)
-  ;; To be implemented.
-  )
-
-(luna-define-method elmo-msgdb-message-entity-set-number ((msgdb modb-standard)
-							  entity
-							  number)
-  ;; To be implemented.
-  )
-
-(luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-standard)
-						     entity field
-						     &optional decode)
-  ;; To be implemented.
-  )
-
-(luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-standard)
-							 entity field value)
-  ;; To be implemented.
-  )
-
-(luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-standard)
-						    entity)
-  ;; To be implemented.
-  )
-
-(luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-standard)
-							 condition
-							 entity flags numbers)
-  ;; To be implemented.
-  )
+(luna-define-method elmo-msgdb-message-number ((msgdb modb-standard)
+					       message-id)
+  (let ((ret (elmo-get-hash-val
+	      message-id
+	      (modb-standard-entity-map-internal msgdb))))
+    (if (eq 'autoload (car-safe ret))
+	;; Not loaded yet but can return number.
+	(nth 1 ret)
+      (elmo-message-entity-number ret))))
+
+(luna-define-method elmo-msgdb-message-field ((msgdb modb-standard)
+					      number field)
+  (let ((ret (elmo-get-hash-val
+	      (modb-standard-key number)
+	      (modb-standard-entity-map-internal msgdb))))
+    (if (and (eq 'autoload (car-safe ret)) (eq field 'message-id))
+	;; Not loaded yet but can return message-id
+	(cdr (cdr ret))
+      (elmo-message-entity-field (elmo-msgdb-message-entity
+				  msgdb (modb-standard-key number))
+				 field))))
+
+(luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key)
+  (when key
+    (modb-standard-message-entity
+     msgdb
+     (cond ((stringp key) key)
+	   ((numberp key) (modb-standard-key key)))
+     'autoload)))
 
 (require 'product)
 (product-provide (provide 'modb-standard) (require 'elmo-version))