* wl-vars.el (wl-summary-update-confirm-threshold): Abolished.
[elisp/wanderlust.git] / elmo / elmo.el
index b16dd97..00d271f 100644 (file)
@@ -1,4 +1,4 @@
-;;; elmo.el -- Elisp Library for Message Orchestration
+;;; elmo.el --- Elisp Library for Message Orchestration.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
@@ -27,7 +27,7 @@
 ;;
 
 ;;; Code:
-;; 
+;;
 
 (require 'luna)
 
@@ -66,6 +66,9 @@ Otherwise, entire fetching of the message is aborted without confirmation."
   :type 'boolean
   :group 'elmo)
 
+(defvar elmo-message-displaying nil
+  "A global switch to indicate message is displaying or not.")
+
 ;;; internal
 (defvar elmo-folder-type-alist nil)
 
@@ -130,7 +133,9 @@ If optional argument NON-PERSISTENT is non-nil, folder is treated as
          (setq prefix (substring name 0 1))
          (setq name (substring name 1)))
       (setq type (intern (car (setq split (split-string name ":")))))
-      (setq name (substring name (+ 1 (length (car split)))))
+      (if (> (length split) 2)
+         (setq name (substring name (+ 1 (length (car split)))))
+       (error "Error in folder name `%s'" original))
       (setq prefix (concat (car split) ":")))
     (setq class (format "elmo-%s" (symbol-name type)))
     (require (intern class))
@@ -159,6 +164,10 @@ If optional LOAD-MSGDB is non-nil, msgdb is loaded.
 (luna-define-generic elmo-folder-check (folder)
   "Check the FOLDER to obtain newest information at the next list operation.")
 
+(luna-define-generic elmo-folder-clear (folder &optional keep-killed)
+  "Clear FOLDER to the initial state.
+If optional KEEP-KILLED is non-nil, killed-list is not cleared.")
+
 (luna-define-generic elmo-folder-commit (folder)
   "Save current status of FOLDER.")
 
@@ -232,7 +241,7 @@ IMPORTANT-MARK is the important mark."
        num-pair result)
     (dolist (mark-pair (or elmo-msgdb-global-mark-alist
                           (setq elmo-msgdb-global-mark-alist
-                                (elmo-object-load 
+                                (elmo-object-load
                                  (expand-file-name
                                   elmo-msgdb-global-mark-filename
                                   elmo-msgdb-dir)))))
@@ -488,7 +497,7 @@ Return newly created temporary directory name which contains temporary files.")
       (if (not ignore-cache)
          (elmo-make-fetch-strategy
           'entire
-          ;; ...But ignore current section cache and re-fetch 
+          ;; ...But ignore current section cache and re-fetch
           ;; if section cache.
           (not (eq (elmo-file-cache-status cache-file) 'section))
           ;; Save cache.
@@ -507,15 +516,18 @@ Return newly created temporary directory name which contains temporary files.")
   ((folder elmo-folder) important-mark)
   t)
 
-(defun elmo-folder-encache (folder numbers)
-  "Encache messages in the FOLDER with NUMBERS."
+(defun elmo-folder-encache (folder numbers &optional unread)
+  "Encache messages in the FOLDER with NUMBERS.
+If UNREAD is non-nil, messages are not marked as read."
   (dolist (number numbers)
-    (elmo-message-encache folder number)))
+    (elmo-message-encache folder number unread)))
 
-(luna-define-generic elmo-message-encache (folder number)
-  "Encache message in the FOLDER with NUMBER.")
+(luna-define-generic elmo-message-encache (folder number &optional read)
+  "Encache message in the FOLDER with NUMBER.
+If READ is non-nil, message is marked as read.")
 
-(luna-define-method elmo-message-encache ((folder elmo-folder) number)
+(luna-define-method elmo-message-encache ((folder elmo-folder) number
+                                         &optional read)
   (elmo-message-fetch
    folder number
    (elmo-make-fetch-strategy 'entire
@@ -523,7 +535,8 @@ Return newly created temporary directory name which contains temporary files.")
                             t   ;save-cache
                             (elmo-file-cache-get-path
                              (elmo-message-field
-                              folder number 'message-id)))))
+                              folder number 'message-id)))
+   nil nil (not read)))
 
 (luna-define-generic elmo-message-fetch (folder number strategy
                                                &optional
@@ -587,16 +600,23 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
 (luna-define-generic elmo-folder-append-msgdb (folder append-msgdb)
   "Append  APPEND-MSGDB to the current msgdb of the folder.")
 
+(luna-define-generic elmo-folder-newsgroups (folder)
+  "Return list of newsgroup name of FOLDER.")
+
+(luna-define-method elmo-folder-newsgroups ((folder elmo-folder))
+  nil)
+
 (luna-define-method elmo-folder-open ((folder elmo-folder)
                                      &optional load-msgdb)
   (elmo-generic-folder-open folder load-msgdb))
 
 (defun elmo-generic-folder-open (folder load-msgdb)
-  (if load-msgdb
-      (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder)))
-  (elmo-folder-set-killed-list-internal
-   folder
-   (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
+  (let ((inhibit-quit t))
+    (if load-msgdb
+       (elmo-folder-set-msgdb-internal folder (elmo-msgdb-load folder)))
+    (elmo-folder-set-killed-list-internal
+     folder
+     (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder))))
   (elmo-folder-open-internal folder))
 
 (luna-define-method elmo-folder-open-internal ((folder elmo-folder))
@@ -662,7 +682,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
   t) ; default is creatable.
 
 (luna-define-method elmo-folder-writable-p ((folder elmo-folder))
-  t) ; default is writable.
+  nil) ; default is not writable.
 
 (luna-define-method elmo-folder-rename ((folder elmo-folder) new-name)
   (let* ((new-folder (elmo-make-folder new-name)))
@@ -757,6 +777,20 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
      info-alist)
     (setq elmo-folder-info-hashtb hashtb)))
 
+(defsubst elmo-diff-new (diff)
+  (when (consp (cdr diff))
+    (car diff)))
+
+(defsubst elmo-diff-unread (diff)
+  (if (consp (cdr diff))
+      (nth 1 diff)
+    (car diff)))
+
+(defsubst elmo-diff-all (diff)
+  (if (consp (cdr diff))
+      (nth 2 diff)
+    (cdr diff)))
+
 (defsubst elmo-strict-folder-diff (folder)
   "Return folder diff information strictly from FOLDER."
   (let* ((dir (elmo-folder-msgdb-path folder))
@@ -853,26 +887,25 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
              (elmo-message-fetch
               src-folder (car numbers)
               (if (and (not (elmo-folder-plugged-p src-folder))
-                       elmo-enable-disconnected-operation)
-                  (if (and (setq cache (elmo-file-cache-get
-                                        (elmo-message-field
-                                         src-folder (car numbers)
-                                         'message-id)))
-                           (eq (elmo-file-cache-status cache) 'entire))
-                      (elmo-make-fetch-strategy
-                       'entire
-                       t
-                       nil (elmo-file-cache-path cache)))
-                (elmo-make-fetch-strategy 'entire))
+                       elmo-enable-disconnected-operation
+                       (setq cache (elmo-file-cache-get
+                                    (elmo-message-field
+                                     src-folder (car numbers)
+                                     'message-id)))
+                       (eq (elmo-file-cache-status cache) 'entire))
+                  (elmo-make-fetch-strategy
+                   'entire t nil (elmo-file-cache-path cache))
+                (elmo-make-fetch-strategy 'entire t))
               nil (current-buffer)
               'unread)
              (unless (eq (buffer-size) 0)
-               (elmo-folder-append-buffer
-                folder
-                (setq unseen (member (elmo-message-mark
-                                      src-folder (car numbers))
-                                     unread-marks))
-                (if same-number (car numbers)))))
+               (setq failure (not
+                              (elmo-folder-append-buffer
+                               folder
+                               (setq unseen (member (elmo-message-mark
+                                                     src-folder (car numbers))
+                                                    unread-marks))
+                               (if same-number (car numbers)))))))
          (error (setq failure t)))
        ;; FETCH & APPEND finished
        (unless failure
@@ -882,6 +915,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
                                   'message-id)
                                  seen-list)))
          (setq succeed-numbers (cons (car numbers) succeed-numbers)))
+       (elmo-progress-notify 'elmo-folder-move-messages)
        (setq numbers (cdr numbers)))
       (if (and seen-list (elmo-folder-persistent-p folder))
          (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
@@ -892,7 +926,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
 
 ;; Arguments should be reduced.
 (defun elmo-folder-move-messages (src-folder msgs dst-folder
-                                            &optional msgdb all done
+                                            &optional msgdb
                                             no-delete-info
                                             no-delete
                                             same-number
@@ -902,16 +936,14 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
     (let* ((messages msgs)
           (elmo-inhibit-display-retrieval-progress t)
           (len (length msgs))
-          (all-msg-num (or all len))
-          (done-msg-num (or done 0))
-          (progress-message (if no-delete
-                                "Copying messages..."
-                              "Moving messages..."))
           succeeds i result)
       (if (eq dst-folder 'null)
          (setq succeeds messages)
-       ;; src is already opened.
+       (unless (elmo-folder-writable-p dst-folder)
+         (error "move: %d is not writable"
+                (elmo-folder-name-internal dst-folder)))
        (when messages
+         ;; src is already opened.
          (elmo-folder-open-internal dst-folder)
          (unless (setq succeeds (elmo-folder-append-messages dst-folder
                                                              src-folder
@@ -931,17 +963,12 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
                   msgs (elmo-folder-msgdb src-folder)
                   unread-marks seen-list))
            (elmo-msgdb-seen-save dir seen-list))))
-      (when (and done
-                (> all-msg-num elmo-display-progress-threshold))
-       (elmo-display-progress
-        'elmo-folder-move-messages progress-message
-        (/ (* done-msg-num 100) all-msg-num)))
       (if (and (not no-delete) succeeds)
          (progn
            (if (not no-delete-info)
                (message "Cleaning up src folder..."))
            (if (and (elmo-folder-delete-messages src-folder succeeds)
-                    (elmo-msgdb-delete-msgs 
+                    (elmo-msgdb-delete-msgs
                      (elmo-folder-msgdb src-folder) succeeds))
                (setq result t)
              (message "move: delete messages from %s failed."
@@ -1075,7 +1102,7 @@ FIELD is a symbol of the field."
                   'read)
               ;; Mark as read duplicates.
               (elmo-folder-mark-as-read folder to-be-deleted))
-             (t 
+             (t
               ;; Do nothing.
               (setq to-be-deleted nil)))
        (elmo-folder-set-msgdb-internal folder
@@ -1092,7 +1119,8 @@ FIELD is a symbol of the field."
 (defun elmo-folder-confirm-appends (appends)
   (let ((len (length appends))
        in)
-    (if (and (> len elmo-folder-update-threshold)
+    (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).  Continue? " len))
            appends
@@ -1104,11 +1132,12 @@ FIELD is a symbol of the field."
                    in (string-to-int in))
              (if (< len in)
                  (throw 'end len))
-             (if (y-or-n-p (format "%d messages are disappeared.  OK? "
+             (if (y-or-n-p (format "%d messages are not appeared.  OK? "
                                    (max (- len in) 0)))
                  (throw 'end in))))
          (nthcdr (max (- len in) 0) appends))
-      (if (and (> len elmo-folder-update-threshold)
+      (if (and elmo-folder-update-threshold
+              (> len elmo-folder-update-threshold)
               (not elmo-folder-update-confirm))
          (nthcdr (max (- len elmo-folder-update-threshold) 0) appends)
        appends))))
@@ -1134,16 +1163,16 @@ FIELD is a symbol of the field."
                                                           number strategy
                                                           &optional
                                                           section unread)
-  (let (cache-file)
+  (let (cache-path cache-file)
     (if (and (elmo-fetch-strategy-use-cache strategy)
+            (setq cache-path (elmo-fetch-strategy-cache-path strategy))
             (setq cache-file (elmo-file-cache-expand-path
-                              (elmo-fetch-strategy-cache-path strategy)
+                              cache-path
                               section))
-            (file-exists-p cache-file))
-       (if (and (elmo-cache-path-section-p cache-file)
-                (eq (elmo-fetch-strategy-entireness strategy) 'entire))
-           (error "Entire message is not cached.")
-         (insert-file-contents-as-binary cache-file))
+            (file-exists-p cache-file)
+            (or (not (elmo-cache-path-section-p cache-file))
+                (not (eq (elmo-fetch-strategy-entireness strategy) 'entire))))
+       (insert-file-contents-as-binary cache-file)
       (elmo-message-fetch-internal folder number strategy section unread)
       (elmo-delete-cr-buffer)
       (when (and (> (buffer-size) 0)
@@ -1153,8 +1182,14 @@ FIELD is a symbol of the field."
         (elmo-fetch-strategy-cache-path strategy)
         section)))))
 
+(luna-define-method elmo-folder-clear ((folder elmo-folder)
+                                      &optional keep-killed)
+  (unless keep-killed
+    (elmo-folder-set-killed-list-internal folder nil))
+  (elmo-folder-set-msgdb-internal folder (elmo-msgdb-clear)))
+
 (defun elmo-folder-synchronize (folder
-                               new-mark             ;"N"
+                               new-mark             ;"N"
                                unread-uncached-mark ;"U"
                                unread-cached-mark   ;"!"
                                read-uncached-mark   ;"u"
@@ -1168,17 +1203,19 @@ are mark strings for new messages, unread but cached messages,
 read but not cached messages, and important messages.
 If optional IGNORE-MSGDB is non-nil, current msgdb is thrown away except
 read mark status. If IGNORE-MSGDB is 'visible-only, only visible messages
-are thrown away and synchronized.
-If NO-CHECK is non-nil, recheck folder is skipped.
+\(the messages which are not in the killed-list\) are thrown away and
+synchronized.
+If NO-CHECK is non-nil, rechecking folder is skipped.
 
 Return a list of
 \(NEW-MSGDB DELETE-LIST CROSSED\)
 NEW-MSGDB is the newly appended msgdb.
 DELETE-LIST is a list of deleted message number.
-CROSSED is cross-posted message number."
+CROSSED is cross-posted message number.
+If update process is interrupted, return nil."
   (let ((killed-list (elmo-folder-killed-list-internal folder))
        (before-append t)
-       number-alist mark-alist 
+       number-alist mark-alist
        old-msgdb diff diff-2 delete-list new-list new-msgdb mark
        seen-list crossed after-append)
     (setq old-msgdb (elmo-folder-msgdb folder))
@@ -1195,11 +1232,7 @@ CROSSED is cross-posted message number."
                            number-alist mark-alist
                            (concat important-mark read-uncached-mark))
                           seen-list))
-         ;; Make killed list as nil.
-         (unless (eq ignore-msgdb 'visible-only)
-           (elmo-folder-set-killed-list-internal folder nil))
-         (elmo-folder-set-msgdb-internal folder
-                                         (elmo-msgdb-clear))))
+         (elmo-folder-clear folder (eq ignore-msgdb 'visible-only))))
     (unless no-check (elmo-folder-check folder))
     (condition-case nil
        (progn
@@ -1210,8 +1243,8 @@ CROSSED is cross-posted message number."
                                      folder
                                      (eq 'visible-only ignore-msgdb))
                                     (unless ignore-msgdb
-                                      (sort (mapcar 
-                                             'car 
+                                      (sort (mapcar
+                                             'car
                                              number-alist)
                                             '<))))
          (message "Checking folder diff...done")
@@ -1238,7 +1271,7 @@ CROSSED is cross-posted message number."
              (progn
                (elmo-folder-update-number folder)
                (elmo-folder-process-crosspost folder)
-               nil ; no update.
+               (list nil nil nil) ; no updates.
                )
            (if delete-list (elmo-msgdb-delete-msgs
                             (elmo-folder-msgdb folder) delete-list))
@@ -1287,7 +1320,7 @@ CROSSED is cross-posted message number."
         (length (length overview))
         (i 0)
         result)
-    (if (elmo-condition-find-key condition "body")
+    (if (not (elmo-condition-in-msgdb-p condition))
        (elmo-folder-search folder condition number-list)
       (while overview
        (if (elmo-msgdb-search-internal condition (car overview)
@@ -1386,8 +1419,8 @@ Return a hashtable for newsgroups."
 
 (defun elmo-quit ()
   "Quit and cleanup ELMO."
-;  (setq elmo-newsgroups-hashtb nil)
   (elmo-crosspost-message-alist-save)
+  (elmo-dop-queue-save)
   ;; Not implemented yet.
   (let ((types elmo-folder-type-alist)
        class)