X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-net.el;h=06c661e031377910c84425f33c65a8663967ad13;hb=fb40159a1fc3d4fb1400f8fe3befb1056bc75b8c;hp=0380a8595bcf92a8e213c39d5186ece18bdddc74;hpb=1390ba9645d9da9599dad97990cbed616e9c0c1a;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el
index 0380a85..06c661e 100644
--- a/elmo/elmo-net.el
+++ b/elmo/elmo-net.el
@@ -1,4 +1,4 @@
-;;; elmo-net.el -- Network module for ELMO.
+;;; elmo-net.el --- Network module for ELMO.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
@@ -24,12 +24,27 @@
 ;;
 
 ;;; Commentary:
-;; 
+;;
+
+(eval-when-compile (require 'cl))
 
-(require 'luna)
 (require 'elmo-util)
+(require 'elmo-dop)
 (require 'elmo-vars)
+(require 'elmo-cache)
+(require 'elmo)
+
+;;; Code:
+;;
+
+;;; ELMO net folder
+(eval-and-compile
+  (luna-define-class elmo-net-folder
+		     (elmo-folder)
+		     (user auth server port stream-type))
+  (luna-define-internal-accessors 'elmo-net-folder))
 
+;;; Session
 (eval-and-compile
   (autoload 'starttls-negotiate "starttls")
   (autoload 'sasl-find-mechanism "sasl")
@@ -45,7 +60,7 @@
 ;;
 (eval-and-compile
   (luna-define-class elmo-network-session () (name
-					      host
+					      server
 					      port
 					      user
 					      auth
@@ -98,28 +113,33 @@
 
 (defsubst elmo-network-session-password-key (session)
   (format "%s:%s/%s@%s:%d"
-	  (elmo-network-session-name-internal session)
+	  (upcase
+	   (nth 1 (split-string (symbol-name
+				 (luna-class-name session)) "[4-]")))
 	  (elmo-network-session-user-internal session)
-	  (symbol-name (or (elmo-network-session-auth-internal session)
-			   'plain))
-	  (elmo-network-session-host-internal session)
+	  (elmo-network-session-auth-internal session)
+	  (elmo-network-session-server-internal session)
 	  (elmo-network-session-port-internal session)))
 
 (defvar elmo-network-session-cache nil)
-(defvar elmo-network-session-name-prefix nil)
 
-(defsubst elmo-network-session-cache-key (name host port user auth stream-type)
-  "Returns session cache key."
+(defsubst elmo-network-session-cache-key (name folder)
+  "Returns session cache key for NAME and FOLDER."
   (format "%s:%s/%s@%s:%d%s"
-	  (concat elmo-network-session-name-prefix name)
-	  user auth host port (or stream-type "")))
+	  name
+	  (elmo-net-folder-user-internal folder)
+	  (elmo-net-folder-auth-internal folder)
+	  (elmo-net-folder-server-internal folder)
+	  (elmo-net-folder-port-internal folder)
+	  (or
+	   (elmo-network-stream-type-spec-string
+	    (elmo-net-folder-stream-type-internal folder)) "")))
 
 (defun elmo-network-clear-session-cache ()
   "Clear session cache."
   (interactive)
-  (mapcar (lambda (pair)
-	    (elmo-network-close-session (cdr pair)))
-	  elmo-network-session-cache)
+  (dolist (pair elmo-network-session-cache)
+    (elmo-network-close-session (cdr pair)))
   (setq elmo-network-session-cache nil))
 
 (defmacro elmo-network-session-buffer (session)
@@ -127,25 +147,23 @@
   (` (process-buffer (elmo-network-session-process-internal
 		      (, session)))))
 
-(defun elmo-network-get-session (class name host port user auth stream-type
-				       &optional if-exists)
+(defun elmo-network-get-session (class name folder &optional if-exists)
   "Get network session from session cache or a new network session.
 CLASS is the class name of the session.
 NAME is the name of the process.
-HOST is the name of the server host.
-PORT is the port number of the service.
-USER is the user-id for the authenticate.
-AUTH is the authenticate method name (symbol).
-STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
+FOLDER is the ELMO folder structure.
 Returns a `elmo-network-session' instance.
 If optional argument IF-EXISTS is non-nil, it does not return session
 if there is no session cache.
 if making session failed, returns nil."
   (let (pair session key)
-    (if (not (elmo-plugged-p host port))
+    (if (not (elmo-plugged-p
+	      (elmo-net-folder-server-internal folder)
+	      (elmo-net-folder-port-internal folder)
+	      (elmo-network-stream-type-symbol
+	       (elmo-net-folder-stream-type-internal folder))))
 	(error "Unplugged"))
-    (setq pair (assoc (setq key (elmo-network-session-cache-key
-				 name host port user auth stream-type))
+    (setq pair (assoc (setq key (elmo-network-session-cache-key name folder))
 		      elmo-network-session-cache))
     (when (and pair
 	       (not (memq (process-status
@@ -160,19 +178,25 @@ if making session failed, returns nil."
 	(cdr pair)			; connection cache exists.
       (unless if-exists
 	(setq session
-	      (elmo-network-open-session class name
-					 host port user auth stream-type))
+	      (elmo-network-open-session
+	       class
+	       name
+	       (elmo-net-folder-server-internal folder)
+	       (elmo-net-folder-port-internal folder)
+	       (elmo-net-folder-user-internal folder)
+	       (elmo-net-folder-auth-internal folder)
+	       (elmo-net-folder-stream-type-internal folder)))
 	(setq elmo-network-session-cache
 	      (cons (cons key session)
 		    elmo-network-session-cache))
 	session))))
 
-(defun elmo-network-open-session (class name host port user auth
+(defun elmo-network-open-session (class name server port user auth
 					stream-type)
   "Open an authenticated network session.
 CLASS is the class name of the session.
 NAME is the name of the process.
-HOST is the name of the server host.
+SERVER is the name of the server server.
 PORT is the port number of the service.
 USER is the user-id for the authenticate.
 AUTH is the authenticate method name (symbol).
@@ -181,7 +205,7 @@ Returns a process object.  if making session failed, returns nil."
   (let ((session
 	 (luna-make-entity class
 			   :name name
-			   :host host
+			   :server server
 			   :port port
 			   :user user
 			   :auth auth
@@ -189,9 +213,9 @@ Returns a process object.  if making session failed, returns nil."
 			   :process nil
 			   :greeting nil))
 	(buffer (format " *%s session for %s@%s:%d%s"
-			(concat elmo-network-session-name-prefix name)
+			name
 			user
-			host
+			server
 			port
 			(or (elmo-network-stream-type-spec-string stream-type)
 			    "")))
@@ -205,19 +229,25 @@ Returns a process object.  if making session failed, returns nil."
 	   session
 	   (setq process (elmo-open-network-stream
 			  (elmo-network-session-name-internal session)
-			  buffer host port stream-type)))
+			  buffer server port stream-type)))
 	  (when process
 	    (elmo-network-initialize-session session)
 	    (elmo-network-authenticate-session session)
 	    (elmo-network-setup-session session)))
       (error
+       (when (eq (car error) 'elmo-open-error)
+	 (elmo-set-plugged nil server port
+			   (elmo-network-stream-type-symbol stream-type)
+			   (current-time))
+	 (message "Auto plugged off at %s:%d :%s" server port (cadr error))
+	 (sit-for 1))
        (when (eq (car error) 'elmo-authenticate-error)
 	 (elmo-remove-passwd (elmo-network-session-password-key session)))
        (elmo-network-close-session session)
        (signal (car error)(cdr error))))
     session))
 
-(defun elmo-open-network-stream (name buffer host service stream-type)
+(defun elmo-open-network-stream (name buffer server service stream-type)
   (let ((auto-plugged (and elmo-auto-change-plugged
 			   (> elmo-auto-change-plugged 0)))
 	process)
@@ -225,25 +255,362 @@ Returns a process object.  if making session failed, returns nil."
 	     (elmo-network-stream-type-feature stream-type))
 	(require (elmo-network-stream-type-feature stream-type)))
     (condition-case err
- 	(let (process-connection-type)
+	(let (process-connection-type)
 	  (as-binary-process
 	   (setq process
 		 (if stream-type
 		     (funcall (elmo-network-stream-type-function stream-type)
-			      name buffer host service)
-		   (open-network-stream name buffer host service)))))
+			      name buffer server service)
+		   (open-network-stream name buffer server service)))))
       (error
        (when auto-plugged
-	 (elmo-set-plugged nil host service (current-time))
-	 (message "Auto plugged off at %s:%d" host service)
+	 (elmo-set-plugged nil server service
+			   (elmo-network-stream-type-symbol stream-type)
+			   (current-time))
+	 (message "Auto plugged off at %s:%d" server service)
 	 (sit-for 1))
        (signal (car err) (cdr err))))
     (when process
       (process-kill-without-query process)
       (when auto-plugged
-	(elmo-set-plugged t host service))
+	(elmo-set-plugged t server service
+			  (elmo-network-stream-type-symbol stream-type)))
       process)))
 
+(defun elmo-get-network-stream-type (symbol)
+  "Return network stream type corresponding to SYMBOL.
+Returned value is searched from `elmo-network-stream-type-alist'."
+  (let ((alist elmo-network-stream-type-alist)
+	spec)
+    (while alist
+      (when (eq (nth 1 (car alist)) symbol)
+	(setq spec (car alist))
+	(setq alist nil))
+      (setq alist (cdr alist)))
+    spec))
+
+(luna-define-method elmo-folder-initialize ((folder
+					     elmo-net-folder)
+					    name)
+  ;; user and auth should be set in subclass.
+  (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name)
+    (if (match-beginning 1)
+	(elmo-net-folder-set-server-internal
+	 folder
+	 (elmo-match-substring 1 name 1)))
+    (if (match-beginning 2)
+	(elmo-net-folder-set-port-internal
+	 folder
+	 (string-to-int (elmo-match-substring 2 name 1))))
+    (if (match-beginning 3)
+	(elmo-net-folder-set-stream-type-internal
+	 folder
+	 (assoc (elmo-match-string 3 name)
+		elmo-network-stream-type-alist)))
+    (substring name 0 (match-beginning 0))))
+
+(luna-define-method elmo-net-port-info ((folder elmo-net-folder))
+  (list (elmo-net-folder-server-internal folder)
+	(elmo-net-folder-port-internal folder)
+	(elmo-network-stream-type-symbol
+	 (elmo-net-folder-stream-type-internal folder))))
+
+(defun elmo-net-port-label (folder)
+  (concat
+   (symbol-name (elmo-folder-type-internal folder))
+   (if (elmo-net-folder-stream-type-internal folder)
+       (concat "!" (symbol-name
+		    (elmo-network-stream-type-symbol
+		     (elmo-net-folder-stream-type-internal
+		      folder)))))))
+
+(luna-define-method elmo-folder-plugged-p ((folder elmo-net-folder))
+  (apply 'elmo-plugged-p
+	 (append (elmo-net-port-info folder)
+		 (list nil (quote (elmo-net-port-label folder))))))
+
+(luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder)
+					     plugged &optional add)
+  (apply 'elmo-set-plugged plugged
+	 (append (elmo-net-port-info folder)
+		 (list nil nil (quote (elmo-net-port-label folder)) add))))
+
+(luna-define-method elmo-folder-create ((folder elmo-net-folder))
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-create-plugged)
+    (elmo-folder-send folder 'elmo-folder-create-unplugged)))
+
+(luna-define-method elmo-folder-create-unplugged ((folder elmo-net-folder))
+  (if elmo-enable-disconnected-operation
+      (elmo-folder-create-dop folder)
+    (error "Unplugged")))
+
+(luna-define-method elmo-folder-exists-p ((folder elmo-net-folder))
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-exists-p-plugged)
+    ;; If unplugged, guess by msgdb.
+    (file-directory-p (elmo-folder-msgdb-path folder))))
+
+(luna-define-method elmo-folder-status ((folder elmo-net-folder))
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-status-plugged)
+    (elmo-folder-send folder 'elmo-folder-status-unplugged)))
+
+(luna-define-method elmo-folder-status-unplugged
+  ((folder elmo-net-folder))
+  (if elmo-enable-disconnected-operation
+      (elmo-folder-status-dop folder)
+    (error "Unplugged")))
+
+(luna-define-method elmo-folder-list-messages-internal
+  ((folder elmo-net-folder) &optional nohide)
+  (elmo-net-folder-list-messages-internal folder nohide))
+
+(defun elmo-net-folder-list-messages-internal (folder nohide)
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-list-messages-plugged nohide)
+    (elmo-folder-send folder 'elmo-folder-list-messages-unplugged)))
+
+(luna-define-method elmo-folder-list-messages-plugged
+  ((folder elmo-net-folder))
+  nil)
+
+;; Should consider offline append and removal.
+(luna-define-method elmo-folder-list-messages-unplugged ((folder
+							  elmo-net-folder))
+  (if elmo-enable-disconnected-operation
+      (let ((deleting (elmo-dop-list-deleting-messages folder)))
+	(nconc
+	 ;; delete deleting messages
+	 (elmo-delete-if
+	  (lambda (number) (memq number deleting))
+	  ;; current number-list.
+	  (mapcar
+	   'car
+	   (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder))))
+	 ;; append appending messages
+	 (mapcar (lambda (x) (* -1 x))
+		 (elmo-dop-spool-folder-list-messages folder))))
+    t))
+
+(luna-define-method elmo-folder-list-unreads :around ((folder
+						       elmo-net-folder))
+  (if (and (elmo-folder-plugged-p folder)
+	   (elmo-folder-use-flag-p folder))
+      (elmo-folder-send folder 'elmo-folder-list-unreads-plugged)
+    (luna-call-next-method)))
+
+(luna-define-method elmo-folder-list-importants :around ((folder
+							  elmo-net-folder))
+  (if (and (elmo-folder-plugged-p folder)
+	   (elmo-folder-use-flag-p folder))
+      (elmo-folder-send folder 'elmo-folder-list-importants-plugged)
+    (luna-call-next-method)))
+
+(luna-define-method elmo-folder-list-answereds :around ((folder
+							 elmo-net-folder))
+  (if (and (elmo-folder-plugged-p folder)
+	   (elmo-folder-use-flag-p folder))
+      (elmo-folder-send folder 'elmo-folder-list-answereds-plugged)
+    (luna-call-next-method)))
+
+(luna-define-method elmo-folder-list-unreads-plugged
+  ((folder elmo-net-folder))
+  t)
+
+(luna-define-method elmo-folder-list-importants-plugged
+  ((folder elmo-net-folder))
+  t)
+
+(luna-define-method elmo-folder-list-answereds-plugged
+  ((folder elmo-net-folder))
+  t)
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder)
+						 numbers)
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers)
+    (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers)))
+
+(luna-define-method elmo-folder-delete-messages-unplugged ((folder
+							    elmo-net-folder)
+							   numbers)
+  (elmo-folder-delete-messages-dop folder numbers))
+
+(luna-define-method elmo-folder-msgdb-create ((folder elmo-net-folder)
+					      numbers flag-table)
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-msgdb-create-plugged
+			numbers flag-table)
+    (elmo-folder-send folder 'elmo-folder-msgdb-create-unplugged
+		      numbers flag-table)))
+
+(luna-define-method elmo-folder-msgdb-create-unplugged ((folder
+							 elmo-net-folder)
+							numbers
+							flag-table)
+  ;; XXXX should be appended to already existing msgdb.
+  (elmo-dop-msgdb
+   (elmo-folder-msgdb-create (elmo-dop-spool-folder folder)
+			     (mapcar 'abs numbers)
+			     flag-table)))
+
+(luna-define-method elmo-folder-unmark-important :before ((folder
+							   elmo-net-folder)
+							  numbers
+							  &optional
+							  ignore-flag)
+  (when (and (elmo-folder-use-flag-p folder)
+	     (not ignore-flag))
+    (if (elmo-folder-plugged-p folder)
+	(elmo-folder-send folder 'elmo-folder-unmark-important-plugged
+			  numbers)
+      (elmo-folder-send folder
+			'elmo-folder-unmark-important-unplugged numbers))))
+
+(luna-define-method elmo-folder-mark-as-important :before ((folder
+							    elmo-net-folder)
+							   numbers
+							   &optional
+							   ignore-flag)
+  (when (and (elmo-folder-use-flag-p folder)
+	     (not ignore-flag))
+    (if (elmo-folder-plugged-p folder)
+	(elmo-folder-send folder 'elmo-folder-mark-as-important-plugged
+			  numbers)
+      (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged
+			numbers))))
+
+(luna-define-method elmo-folder-unmark-read :before ((folder elmo-net-folder)
+						     numbers
+						     &optional ignore-flag)
+  (when (and (elmo-folder-use-flag-p folder)
+	     (not ignore-flag))
+    (if (elmo-folder-plugged-p folder)
+	(elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers)
+      (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers))))
+
+(luna-define-method elmo-folder-mark-as-read :before ((folder elmo-net-folder)
+						      numbers
+						      &optional ignore-flag)
+  (when (and (elmo-folder-use-flag-p folder)
+	     (not ignore-flag))
+    (if (elmo-folder-plugged-p folder)
+	(elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers)
+      (elmo-folder-send
+       folder 'elmo-folder-mark-as-read-unplugged numbers))))
+
+(luna-define-method elmo-folder-unmark-answered :before ((folder
+							  elmo-net-folder)
+							 numbers)
+  (when (elmo-folder-use-flag-p folder)
+    (if (elmo-folder-plugged-p folder)
+	(elmo-folder-send folder 'elmo-folder-unmark-answered-plugged
+			  numbers)
+      (elmo-folder-send folder
+			'elmo-folder-unmark-answered-unplugged numbers))))
+
+(luna-define-method elmo-folder-mark-as-answered :before ((folder
+							   elmo-net-folder)
+							  numbers)
+  (when (elmo-folder-use-flag-p folder)
+    (if (elmo-folder-plugged-p folder)
+	(elmo-folder-send folder 'elmo-folder-mark-as-answered-plugged
+			  numbers)
+      (elmo-folder-send folder 'elmo-folder-mark-as-answered-unplugged
+			numbers))))
+
+(luna-define-method elmo-folder-mark-as-read-unplugged ((folder
+							 elmo-net-folder)
+							numbers)
+  (elmo-folder-mark-as-read-dop folder numbers))
+
+(luna-define-method elmo-folder-unmark-read-unplugged ((folder elmo-net-folder)
+						     numbers)
+  (elmo-folder-unmark-read-dop folder numbers))
+
+(luna-define-method elmo-folder-mark-as-important-unplugged ((folder
+							      elmo-net-folder)
+							     numbers)
+  (elmo-folder-mark-as-important-dop folder numbers))
+
+(luna-define-method elmo-folder-unmark-important-unplugged ((folder
+							     elmo-net-folder)
+							    numbers)
+  (elmo-folder-unmark-important-dop folder numbers))
+
+(luna-define-method elmo-folder-mark-as-answered-unplugged ((folder
+							     elmo-net-folder)
+							    numbers)
+  (elmo-folder-mark-as-answered-dop folder numbers))
+
+(luna-define-method elmo-folder-unmark-answered-unplugged
+  ((folder elmo-net-folder) numbers)
+  (elmo-folder-unmark-answered-dop folder numbers))
+
+(luna-define-method elmo-message-encache :around ((folder elmo-net-folder)
+						  number &optional read)
+  (if (elmo-folder-plugged-p folder)
+      (luna-call-next-method)
+    (if elmo-enable-disconnected-operation
+	(elmo-message-encache-dop folder number read)
+      (error "Unplugged"))))
+
+(luna-define-generic elmo-message-fetch-plugged (folder number strategy
+							&optional
+							section
+							outbuf
+							unseen)
+  "")
+
+(luna-define-generic elmo-message-fetch-unplugged (folder number strategy
+							  &optional
+							  section
+							  outbuf
+							  unseen)
+  "")
+
+(luna-define-method elmo-message-fetch-internal ((folder elmo-net-folder)
+						 number strategy
+						 &optional section unseen)
+  (if (elmo-folder-plugged-p folder)
+      (elmo-message-fetch-plugged folder number
+				  strategy section
+				  (current-buffer) unseen)
+    (elmo-message-fetch-unplugged folder number
+				  strategy section
+				  (current-buffer) unseen)))
+
+(luna-define-method elmo-message-fetch-unplugged
+  ((folder elmo-net-folder) number strategy  &optional section outbuf unseen)
+  (if (and elmo-enable-disconnected-operation
+	   (< number 0))
+      (elmo-message-fetch-internal
+       (elmo-dop-spool-folder folder) (abs number) strategy
+       section unseen)
+    (error "Unplugged")))
+
+(luna-define-method elmo-folder-check ((folder elmo-net-folder))
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-check-plugged)))
+
+(luna-define-method elmo-folder-close :after ((folder elmo-net-folder))
+  (if (elmo-folder-plugged-p folder)
+      (elmo-folder-send folder 'elmo-folder-check-plugged)))
+
+(luna-define-method elmo-folder-diff :around ((folder elmo-net-folder)
+					      &optional numbers)
+  (if (and (elmo-folder-use-flag-p folder)
+	   (elmo-folder-plugged-p folder))
+      (elmo-folder-send folder 'elmo-folder-diff-plugged)
+    (luna-call-next-method)))
+
+(luna-define-method elmo-folder-local-p ((folder elmo-net-folder))
+  nil)
+
+(luna-define-method elmo-quit ((folder elmo-net-folder))
+  (elmo-network-clear-session-cache))
+
 (require 'product)
 (product-provide (provide 'elmo-net) (require 'elmo-version))