X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnoo.el;h=bb7704f12cbdd9be85cfde1cc7c8b7ac1006a8ee;hb=9239a649d21e1fb7945f793fe8a604786b6cb438;hp=aa861ce3116e222e5ac2259997b53ce631887645;hpb=4dbdde2be596c8a2bfd3920bd1c6aae8144710be;p=gnus

diff --git a/lisp/nnoo.el b/lisp/nnoo.el
index aa861ce31..bb7704f12 100644
--- a/lisp/nnoo.el
+++ b/lisp/nnoo.el
@@ -1,7 +1,9 @@
 ;;; nnoo.el --- OO Gnus Backends
-;; Copyright (C) 1996 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;;	Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -26,16 +28,17 @@
 ;;; Code:
 
 (require 'nnheader)
-(require 'cl)
+(eval-when-compile (require 'cl))
 
 (defvar nnoo-definition-alist nil)
 (defvar nnoo-state-alist nil)
+(defvar nnoo-parent-backend nil)
 
 (defmacro defvoo (var init &optional doc &rest map)
   "The same as `defvar', only takes list of variables to MAP to."
   `(prog1
        ,(if doc
-	    `(defvar ,var ,init ,doc)
+	    `(defvar ,var ,init ,(concat doc "\n\nThis is a Gnus server variable.  See Info node `(gnus)Select Methods'."))
 	  `(defvar ,var ,init))
      (nnoo-define ',var ',map)))
 (put 'defvoo 'lisp-indent-function 2)
@@ -58,10 +61,12 @@
 
 (defmacro nnoo-declare (backend &rest parents)
   `(eval-and-compile
-     (push (list ',backend 
+     (push (list ',backend
 		 (mapcar (lambda (p) (list p)) ',parents)
 		 nil nil)
-	   nnoo-definition-alist)))
+	   nnoo-definition-alist)
+     (push (list ',backend "*internal-non-initialized-backend*")
+	   nnoo-state-alist)))
 (put 'nnoo-declare 'lisp-indent-function 1)
 
 (defun nnoo-parents (backend)
@@ -86,25 +91,42 @@
 	    (or (cdr imp)
 		(nnoo-functions (car imp))))
       (while functions
-	(unless (fboundp (setq function
-			       (nnoo-symbol backend (nnoo-rest-symbol
-						     (car functions)))))
+	(unless (fboundp
+		 (setq function
+		       (nnoo-symbol backend
+				    (nnoo-rest-symbol (car functions)))))
 	  (eval `(deffoo ,function (&rest args)
 		   (,call-function ',backend ',(car functions) args))))
 	(pop functions)))))
 
 (defun nnoo-parent-function (backend function args)
-  (let* ((pbackend (nnoo-backend function)))
-    (nnoo-change-server pbackend (nnoo-current-server backend)
+  (let ((pbackend (nnoo-backend function))
+	(nnoo-parent-backend backend))
+    (nnoo-change-server pbackend
+			(nnoo-current-server backend)
 			(cdr (assq pbackend (nnoo-parents backend))))
-    (apply function args)))
+    (prog1
+	(apply function args)
+      ;; Copy the changed variables back into the child.
+      (let ((vars (cdr (assq pbackend (nnoo-parents backend)))))
+	(while vars
+	  (set (cadar vars) (symbol-value (caar vars)))
+	  (setq vars (cdr vars)))))))
 
 (defun nnoo-execute (backend function &rest args)
   "Execute FUNCTION on behalf of BACKEND."
-  (let* ((pbackend (nnoo-backend function)))
-    (nnoo-change-server pbackend (nnoo-current-server backend)
+  (let ((pbackend (nnoo-backend function))
+	(nnoo-parent-backend backend))
+    (nnoo-change-server pbackend
+			(nnoo-current-server backend)
 			(cdr (assq pbackend (nnoo-parents backend))))
-    (apply function args)))
+    (prog1
+	(apply function args)
+      ;; Copy the changed variables back into the child.
+      (let ((vars (cdr (assq pbackend (nnoo-parents backend)))))
+	(while vars
+	  (set (cadar vars) (symbol-value (caar vars)))
+	  (setq vars (cdr vars)))))))
 
 (defmacro nnoo-map-functions (backend &rest maps)
   `(nnoo-map-functions-1 ',backend ',maps))
@@ -124,7 +146,7 @@
 		 (&rest args)
 	       (nnoo-parent-function ',backend ',(car m)
 				     ,(cons 'list (nreverse margs))))))))
-  
+
 (defun nnoo-backend (symbol)
   (string-match "^[^-]+-" (symbol-name symbol))
   (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
@@ -141,7 +163,7 @@
 	 (def (assq backend nnoo-definition-alist))
 	 (parents (nth 1 def)))
     (unless def
-      (error "%s belongs to a backend that hasn't been declared." var))
+      (error "%s belongs to a backend that hasn't been declared" var))
     (setcar (nthcdr 2 def)
 	    (delq (assq var (nth 2 def)) (nth 2 def)))
     (setcar (nthcdr 2 def)
@@ -155,8 +177,13 @@
   (let* ((bstate (cdr (assq backend nnoo-state-alist)))
 	 (current (car bstate))
 	 (parents (nnoo-parents backend))
+	 (server (if nnoo-parent-backend
+		     (format "%s+%s" nnoo-parent-backend server)
+		   server))
 	 (bvariables (nnoo-variables backend))
 	 state def)
+    ;; If we don't have a current state, we push an empty state
+    ;; onto the alist.
     (unless bstate
       (push (setq bstate (list backend nil))
 	    nnoo-state-alist)
@@ -174,11 +201,14 @@
 	(while (setq def (pop defs))
 	  (unless (assq (car def) bvariables)
 	    (nconc bvariables
-		   (list (cons (car def) (symbol-value (car def))))))
-	  (set (car def) (cadr def))))
+		   (list (cons (car def) (and (boundp (car def))
+					      (symbol-value (car def)))))))
+	  (if (equal server "*internal-non-initialized-backend*")
+	      (set (car def) (symbol-value (cadr def)))
+	    (set (car def) (cadr def)))))
       (while parents
-	(nnoo-change-server 
-	 (caar parents) server 
+	(nnoo-change-server
+	 (caar parents) (format "%s+%s" backend server)
 	 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
 		 (cdar parents)))
 	(pop parents))))
@@ -189,6 +219,14 @@
 	(defs (nnoo-variables backend)))
     ;; Remove the old definition.
     (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
+    ;; If this is the first time we push the server (i. e., this is
+    ;; the nil server), then we update the default values of
+    ;; all the variables to reflect the current values.
+    (when (equal current "*internal-non-initialized-backend*")
+      (let ((defaults (nnoo-variables backend))
+	    def)
+	(while (setq def (pop defaults))
+	  (setcdr def (symbol-value (car def))))))
     (let (state)
       (while defs
 	(push (cons (caar defs) (symbol-value (caar defs)))
@@ -196,8 +234,11 @@
 	(pop defs))
       (nconc bstate (list (cons current state))))))
 
-(defun nnoo-current-server-p (backend server)
-  (equal (nnoo-current-server backend) server))
+(defsubst nnoo-current-server-p (backend server)
+  (equal (nnoo-current-server backend)
+	 (if nnoo-parent-backend
+	     (format "%s+%s" nnoo-parent-backend server)
+	   server)))
 
 (defun nnoo-current-server (backend)
   (nth 1 (assq backend nnoo-state-alist)))
@@ -213,7 +254,7 @@
 	(setcdr bstate (delq defs (cdr bstate)))
 	(pop defs)
 	(while defs
-	  (set (car (pop defs)) nil)))))
+	  (set (car (pop defs)) nil))))) 
   t)
 
 (defun nnoo-close (backend)
@@ -254,7 +295,7 @@ All functions will return nil and report an error."
 (defun nnoo-define-skeleton-1 (backend)
   (let ((functions '(retrieve-headers
 		     request-close request-article
-		     open-group request-group close-group
+		     request-group close-group
 		     request-list request-post request-list-newsgroups))
 	function fun)
     (while (setq function (pop functions))
@@ -263,6 +304,20 @@ All functions will return nil and report an error."
 		   (&rest args)
 		 (nnheader-report ',backend ,(format "%s-%s not implemented"
 						     backend function))))))))
+
+(defun nnoo-set (server &rest args)
+  (let ((parents (nnoo-parents (car server)))
+	(nnoo-parent-backend (car server)))
+    (while parents
+      (nnoo-change-server (caar parents)
+			  (cadr server)
+			  (cdar parents))
+      (pop parents)))
+  (nnoo-change-server (car server)
+		      (cadr server) (cddr server))
+  (while args
+    (set (pop args) (pop args))))
+
 (provide 'nnoo)
 
-;;; nnoo.el ends here.
+;;; nnoo.el ends here