X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=inline;f=elmo%2Felmo.el;h=00d271fdb7da3d048b2cb558f51a5105e589c419;hb=fff721070783297e37f944185f145ce6ff4f581e;hp=2543d9d7731cb6b3108dff778183a47ffce28d24;hpb=192351f30c4a1cd89b5c5363b86cbf9653ce420d;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo.el b/elmo/elmo.el index 2543d9d..00d271f 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -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 @@ -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)) @@ -236,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))))) @@ -492,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. @@ -511,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 @@ -528,7 +536,7 @@ Return newly created temporary directory name which contains temporary files.") (elmo-file-cache-get-path (elmo-message-field folder number 'message-id))) - nil nil 'unread)) + nil nil (not read))) (luna-define-generic elmo-message-fetch (folder number strategy &optional @@ -592,6 +600,12 @@ 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)) @@ -668,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))) @@ -763,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)) @@ -871,12 +899,13 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).") 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 @@ -886,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) @@ -896,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 @@ -906,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 @@ -935,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." @@ -1079,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 @@ -1096,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 @@ -1108,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)))) @@ -1138,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) @@ -1164,7 +1189,7 @@ FIELD is a symbol of the field." (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" @@ -1178,7 +1203,7 @@ 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 -\(the messages which are not in the killed-list\) are thrown away and +\(the messages which are not in the killed-list\) are thrown away and synchronized. If NO-CHECK is non-nil, rechecking folder is skipped. @@ -1190,7 +1215,7 @@ 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)) @@ -1218,8 +1243,8 @@ If update process is interrupted, return nil." folder (eq 'visible-only ignore-msgdb)) (unless ignore-msgdb - (sort (mapcar - 'car + (sort (mapcar + 'car number-alist) '<)))) (message "Checking folder diff...done") @@ -1394,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)