X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo.el;h=15c935e92080fa417d5a814d73eacdba0a91cbac;hb=dc2fa85ae16caaccdfe5d961e4e40e81b24973cb;hp=d1a2b2b5b527569d0c9bbdee5f442f883ee91a77;hpb=d18080c5c6d2cb318ce0d8cbbb9d9d1de343105c;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo.el b/elmo/elmo.el
index d1a2b2b..15c935e 100644
--- a/elmo/elmo.el
+++ b/elmo/elmo.el
@@ -95,8 +95,8 @@ Otherwise, entire fetching of the message is aborted without confirmation."
 (elmo-define-signal flag-changed (numbers)
   "Notify the change flag of the messages with NUMBERS.")
 
-(elmo-define-signal cache-changed (number)
-  "Notify the change cache status of the message with NUMBER.")
+(elmo-define-signal status-changed (numbers)
+  "Notify the change status of the message with NUMBERS.")
 
 (elmo-define-signal update-overview (number)
   "Notify update overview of the message with NUMBER.")
@@ -114,10 +114,12 @@ Otherwise, entire fetching of the message is aborted without confirmation."
   (autoload 'elmo-global-flag-detach "elmo-flag")
   (autoload 'elmo-global-flag-detach-messages "elmo-flag")
   (autoload 'elmo-global-flag-set "elmo-flag")
+  (autoload 'elmo-global-flag-replace-referrer "elmo-flag")
   (autoload 'elmo-get-global-flags "elmo-flag")
   (autoload 'elmo-global-flags-initialize "elmo-flag")
   (autoload 'elmo-global-mark-migrate "elmo-flag")
-  (autoload 'elmo-folder-list-global-flag-messages "elmo-flag"))
+  (autoload 'elmo-folder-list-global-flag-messages "elmo-flag")
+  (autoload 'elmo-search-register-engine "elmo-search"))
 
 (defun elmo-define-folder (prefix backend)
   "Define a folder.
@@ -159,7 +161,7 @@ If a folder name begins with PREFIX, use BACKEND."
 
 (defmacro elmo-folder-send (folder message &rest args)
   "Let FOLDER receive the MESSAGE with ARGS."
-  (` (luna-send (, folder) (, message) (, folder) (,@ args))))
+  `(luna-send ,folder ,message ,folder ,@args))
 
 ;;;###autoload
 (defun elmo-make-folder (name &optional non-persistent mime-charset)
@@ -190,6 +192,13 @@ encode and decode a multibyte string."
     (save-match-data
       (elmo-folder-send folder 'elmo-folder-initialize name))))
 
+(defvar elmo-get-folder-function nil)
+
+(defun elmo-get-folder (name)
+  (or (and elmo-get-folder-function
+	   (funcall elmo-get-folder-function name))
+      (elmo-make-folder name)))
+
 ;; Note that this function is for internal use only.
 (luna-define-generic elmo-folder-msgdb (folder)
   "Return the msgdb of FOLDER (on-demand loading).
@@ -425,21 +434,6 @@ If optional argument NUMBER is specified, the new message number is set
 \(if possible\).
 Return nil on failure.")
 
-(luna-define-generic elmo-folder-append-messages (folder
-						  src-folder
-						  numbers
-						  &optional
-						  same-number)
-  "Append messages from folder.
-FOLDER is the ELMO folder structure.
-Caller should make sure FOLDER is `writable'.
-\(Can be checked with `elmo-folder-writable-p'\).
-SRC-FOLDER is the source ELMO folder structure.
-NUMBERS is the message numbers to be appended in the SRC-FOLDER.
-If second optional argument SAME-NUMBER is specified,
-message number is preserved \(if possible\).
-Returns a list of message numbers successfully appended.")
-
 (luna-define-generic elmo-folder-pack-numbers (folder)
   "Pack message numbers of FOLDER.")
 
@@ -777,14 +771,19 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
     t))
 
 (luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
-  (let* ((new-folder (elmo-make-folder new-name)))
+  (let ((new-folder (elmo-make-folder
+		     new-name
+		     nil
+		     (elmo-folder-mime-charset-internal folder))))
     (unless (eq (elmo-folder-type-internal folder)
 		(elmo-folder-type-internal new-folder))
       (error "Not same folder type"))
-    (if (or (file-exists-p (elmo-folder-msgdb-path new-folder))
-	    (elmo-folder-exists-p new-folder))
-	(error "Already exists folder: %s" new-name))
+    (when (or (file-exists-p (elmo-folder-msgdb-path new-folder))
+	      (elmo-folder-exists-p new-folder))
+      (error "Already exists folder: %s" new-name))
     (elmo-folder-send folder 'elmo-folder-rename-internal new-folder)
+    (elmo-global-flag-replace-referrer (elmo-folder-name-internal folder)
+				       new-name)
     (elmo-msgdb-rename-path folder new-folder)))
 
 (luna-define-method elmo-folder-delete-messages ((folder elmo-folder)
@@ -809,10 +808,9 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
 							 numbers))))
 	(setq numbers results
 	      condition (nth 2 condition)))
-      (let ((len (length numbers))
-	    matched)
-	(elmo-with-progress-display (> len elmo-display-progress-threshold)
-	    (elmo-folder-search len "Searching...")
+      (let (matched)
+	(elmo-with-progress-display (elmo-folder-search (length numbers))
+	    "Searching messages"
 	  (dolist (number numbers)
 	    (let (result)
 	      (setq result (elmo-msgdb-match-condition msgdb
@@ -827,7 +825,6 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
 	      (when result
 		(setq matched (cons number matched))))
 	    (elmo-progress-notify 'elmo-folder-search)))
-	(message "Searching...done")
 	(nreverse matched)))))
 
 (defun elmo-message-buffer-match-condition (condition number)
@@ -863,7 +860,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-FLAG-ALIST).")
     (when (and filename (file-readable-p filename))
       (with-temp-buffer
 	(set-buffer-multibyte nil)
-	;;(insert-file-contents-as-binary filename)
+;;;	(insert-file-contents-as-binary filename)
 	(elmo-message-fetch folder number
 			    (elmo-make-fetch-strategy 'entire
 						      (and cache t)
@@ -957,7 +954,8 @@ If optional argument IF-EXISTS is nil, load on demand.
   (elmo-folder-set-info-hashtb
    folder
    (if numbers (apply #'max numbers) 0)
-   nil ;;(length num-db)
+;;;   (length num-db)
+   nil
    ))
 
 (defun elmo-folder-get-info-max (folder)
@@ -976,7 +974,7 @@ If optional argument IF-EXISTS is nil, load on demand.
   "Setup folder info hashtable by INFO-ALIST on HASHTB."
   (let* ((hashtb (or hashtb
 		     (elmo-make-hash (length info-alist)))))
-    (mapcar
+    (mapc
      (lambda (x)
        (let ((info (cadr x)))
 	 (and (intern-soft (car x) hashtb)
@@ -1067,20 +1065,73 @@ If optional argument IF-EXISTS is nil, load on demand.
   (+ 1 (elmo-max-of-list (or (elmo-folder-list-messages folder)
 			     '(0)))))
 
-(luna-define-method elmo-folder-append-messages ((folder elmo-folder)
-						 src-folder
-						 numbers
-						 &optional
-						 same-number)
-  (elmo-generic-folder-append-messages folder src-folder numbers
-				       same-number))
+(eval-and-compile
+  (luna-define-class elmo-file-tag))
+
+(defconst elmo-append-messages-dispatch-table
+  '(((nil	. null)		. elmo-folder-append-messages-*-null)
+    ((filter	. nil)		. elmo-folder-append-messages-filter-*)
+    ((nil	. filter)	. elmo-folder-append-messages-*-filter)
+    ((pipe	. nil)		. elmo-folder-append-messages-pipe-*)
+    ((nil	. pipe)		. elmo-folder-append-messages-*-pipe)
+    ((multi	. nil)		. elmo-folder-append-messages-multi-*)
+    ((nil	. flag)		. elmo-folder-append-messages-*-flag)
+    ((imap4	. imap4)	. elmo-folder-append-messages-imap4-imap4)
+    ((elmo-file-tag . localdir)	. elmo-folder-append-messages-*-localdir)
+    ((elmo-file-tag . maildir)	. elmo-folder-append-messages-*-maildir)
+    ((nil	. archive)	. elmo-folder-append-messages-*-archive)
+    ((nil	. nil)		. elmo-generic-folder-append-messages)))
+
+(defun elmo-folder-type-p (folder type)
+  (or (null type)
+      (eq (elmo-folder-type-internal folder) type)
+      (labels ((member-if (predicate list)
+			  (and list
+			       (or (funcall predicate (car list))
+				   (member-if predicate (cdr list)))))
+	       (subtypep (name type)
+			 (or (eq name type)
+			     (let ((class (luna-find-class name)))
+			       (and class
+				    (member-if (lambda (name)
+						 (subtypep name type))
+					       (luna-class-parents class)))))))
+	(subtypep (luna-class-name folder)
+		  (or (intern-soft (format "elmo-%s-folder" type))
+		      type)))))
+
+(defun elmo-folder-append-messages (dst-folder src-folder numbers
+					       &optional same-number caller)
+  "Append messages from folder.
+DST-FOLDER is the ELMO folder structure.
+Caller should make sure DST-FOLDER is `writable'.
+\(Can be checked with `elmo-folder-writable-p'\).
+SRC-FOLDER is the source ELMO folder structure.
+NUMBERS is the message numbers to be appended in the SRC-FOLDER.
+If second optional argument SAME-NUMBER is specified,
+message number is preserved \(if possible\).
+Returns a list of message numbers successfully appended."
+  (let ((rest (if caller
+		  (cdr (memq (rassq caller elmo-append-messages-dispatch-table)
+			     elmo-append-messages-dispatch-table))
+		elmo-append-messages-dispatch-table))
+	result)
+    (while rest
+      (let ((types (car (car rest))))
+	(if (and (elmo-folder-type-p src-folder (car types))
+		 (elmo-folder-type-p dst-folder (cdr types)))
+	    (setq result (funcall (cdr (car rest))
+				  dst-folder src-folder numbers same-number)
+		  rest nil)
+	  (setq rest (cdr rest)))))
+    result))
 
 (defun elmo-generic-folder-append-messages (folder src-folder numbers
 						   same-number)
   (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
-	unseen table
+	unseen
 	succeed-numbers failure cache id)
-    (setq table (elmo-folder-flag-table folder))
+    (elmo-folder-flag-table folder) ; load
     (with-temp-buffer
       (set-buffer-multibyte nil)
       (while numbers
@@ -1129,7 +1180,6 @@ If optional argument IF-EXISTS is nil, load on demand.
 					     same-number)
   (save-excursion
     (let* ((messages msgs)
-	   (elmo-inhibit-display-retrieval-progress t)
 	   (len (length msgs))
 	   succeeds i result)
       (if (eq dst-folder 'null)
@@ -1160,7 +1210,7 @@ If optional argument IF-EXISTS is nil, load on demand.
 	    result)
 	(if no-delete
 	    (progn
-	      ;; (message "Copying messages...done")
+;;;	      (message "Copying messages...done")
 	      t)
 	  (if (eq len 0)
 	      (message "No message was moved.")
@@ -1193,6 +1243,14 @@ If optional argument IF-EXISTS is nil, load on demand.
 (luna-define-method elmo-message-cached-p ((folder elmo-folder) number)
   (elmo-message-flagged-p folder number 'cached))
 
+(luna-define-generic elmo-message-killed-p (folder number)
+  "Return non-nil if the message is killed.")
+
+(luna-define-method elmo-message-killed-p ((folder elmo-folder) number)
+  (let ((killed-list (elmo-folder-killed-list-internal folder)))
+    (and killed-list
+	 (elmo-number-set-member number killed-list))))
+
 (defun elmo-message-accessible-p (folder number)
   "Get accessibility of the message.
 Return non-nil when message is accessible."
@@ -1212,7 +1270,7 @@ If CACHED is t, message is set as cached.")
   (if cached
       (elmo-msgdb-set-flag (elmo-folder-msgdb folder) number 'cached)
     (elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number 'cached))
-  (elmo-emit-signal 'cache-changed folder number))
+  (elmo-emit-signal 'status-changed folder (list number)))
 
 (defun elmo-message-copy-entity (entity)
   (elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity)
@@ -1393,10 +1451,10 @@ If Optional LOCAL is non-nil, don't update server flag."
   ;; Do nothing.
   )
 
-;;(luna-define-generic elmo-folder-append-message-entity (folder entity
-;;							       &optional
-;;							       flag-table)
-;;  "Append ENTITY to the folder.")
+;;;(luna-define-generic elmo-folder-append-message-entity (folder entity
+;;;							       &optional
+;;;							       flag-table)
+;;;  "Append ENTITY to the folder.")
 
 (defun elmo-msgdb-merge (folder msgdb-merge)
   "Return a list of messages which have duplicated message-id."
@@ -1426,20 +1484,22 @@ If Optional LOCAL is non-nil, don't update server flag."
 	(length duplicates))
     0))
 
-(defun elmo-folder-confirm-appends (appends)
+(defun elmo-folder-confirm-appends (folder appends)
   (let ((len (length appends))
 	in)
     (if (and elmo-folder-update-threshold
 	     (> len elmo-folder-update-threshold)
 	     elmo-folder-update-confirm)
-	(if (y-or-n-p (format "Too many messages(%d).  Update all? " len))
+	(if (y-or-n-p (format
+		       "Too many messages(%d) in %s.  Update all? "
+		       len (elmo-folder-name-internal folder)))
 	    appends
 	  (setq in elmo-folder-update-threshold)
 	  (catch 'end
 	    (while t
 	      (setq in (read-from-minibuffer "Update number: "
-					     (int-to-string in))
-		    in (string-to-int in))
+					     (number-to-string in))
+		    in (string-to-number in))
 	      (if (< len in)
 		  (throw 'end len))
 	      (if (y-or-n-p (format
@@ -1524,6 +1584,23 @@ If Optional LOCAL is non-nil, don't update server flag."
     numbers))
   (elmo-folder-unset-flag folder numbers 'all 'local-only))
 
+(luna-define-generic elmo-folder-recover-messages (folder numbers)
+  "Recover killed messages in the FOLDER with NUMBERS.")
+
+(luna-define-method elmo-folder-recover-messages ((folder elmo-folder) numbers)
+  (let ((msgdb (elmo-folder-msgdb folder)))
+    (elmo-folder-set-killed-list-internal
+     folder
+     (elmo-number-set-delete-list
+      (elmo-folder-killed-list-internal folder)
+      numbers))
+    (dolist (number numbers)
+      (if (elmo-file-cache-exists-p
+	   (elmo-message-field folder number 'message-id))
+	  (elmo-msgdb-set-flag msgdb number 'cached)
+	(elmo-msgdb-unset-flag msgdb number 'cached)))
+    (elmo-emit-signal 'status-changed folder numbers)))
+
 (luna-define-method elmo-folder-clear ((folder elmo-folder)
 				       &optional keep-killed)
   (unless keep-killed
@@ -1582,7 +1659,7 @@ If update process is interrupted, return nil.")
 	    (when (and mask (not ignore-msgdb))
 	      (setq diff-new (elmo-list-filter mask diff-new))))
 	  (message "Checking folder diff...done")
-	  (setq new-list (elmo-folder-confirm-appends diff-new))
+	  (setq new-list (elmo-folder-confirm-appends folder diff-new))
 	  ;; Append to killed list as (MIN-OF-DISAPPEARED . MAX-OF-DISAPPEARED)
 	  (when (not (eq (length diff-new)
 			 (length new-list)))
@@ -1699,8 +1776,8 @@ Return a hashtable for newsgroups."
       (while alist
 	(setq newsgroups
 	      (elmo-delete-if
-	       '(lambda (x)
-		  (not (intern-soft x elmo-newsgroups-hashtb)))
+	       (lambda (x)
+		 (not (intern-soft x elmo-newsgroups-hashtb)))
 	       (nth 1 (car alist))))
 	(if newsgroups
 	    (setcar (cdar alist) newsgroups)
@@ -1719,6 +1796,42 @@ Return a hashtable for newsgroups."
     (elmo-make-directory temp-dir)
     temp-dir))
 
+;; ELMO status structure.
+(defmacro elmo-message-status (folder number &optional flags killed)
+  "Make ELMO status structure from FOLDER and NUMBER.
+A value in this structure is cached at first access."
+  `(vector ,folder ,number ,flags ,killed))
+
+(defmacro elmo-message-status-folder (status)
+  `(aref ,status 0))
+
+(defmacro elmo-message-status-number (status)
+  `(aref ,status 1))
+
+(defmacro elmo-message-status-set-flags (status flags)
+  `(aset ,status 2 (or ,flags '(read))))
+
+(defsubst elmo-message-status-flags (status)
+  (or (aref status 2)
+      (elmo-message-status-set-flags
+       status
+       (elmo-message-flags (elmo-message-status-folder status)
+			   (elmo-message-status-number status)))))
+
+(defsubst elmo-message-status-cached-p (status)
+  (memq 'cached (elmo-message-status-flags status)))
+
+(defmacro elmo-message-status-set-killed (status killed)
+  `(aset ,status 3 (if ,killed 'killed 'living)))
+
+(defsubst elmo-message-status-killed-p (status)
+  (eq 'killed
+      (or (aref status 3)
+	  (elmo-message-status-set-killed
+	   status
+	   (elmo-message-killed-p (elmo-message-status-folder status)
+				  (elmo-message-status-number status))))))
+
 ;;;
 (defun elmo-init ()
   "Initialize ELMO module."
@@ -1762,7 +1875,7 @@ Return a hashtable for newsgroups."
 (elmo-define-folder ?|  'pipe)
 (elmo-define-folder ?.  'maildir)
 (elmo-define-folder ?'  'internal)
-(elmo-define-folder ?\[  'nmz)
+(elmo-define-folder ?\[  'search)
 (elmo-define-folder ?@  'shimbun)
 
 ;;; Obsolete variables.
@@ -1802,6 +1915,13 @@ Return a hashtable for newsgroups."
 			       'elmo-msgdb-directory)
 (elmo-define-obsolete-variable 'elmo-global-flag-list
 			       'elmo-global-flags)
+(elmo-define-obsolete-variable 'elmo-nmz-default-index-path
+			       'elmo-search-namazu-default-index-path)
+(elmo-define-obsolete-variable 'elmo-nmz-index-alias-alist
+			       'elmo-search-namazu-index-alias-alist)
+(elmo-define-obsolete-variable 'elmo-nmz-use-drive-letter
+			       'elmo-search-use-drive-letter)
+
 
 ;; Obsolete functions.
 ;; 2001-12-11: *-dir -> *-directory