X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnoo.el;h=8a360d9e1f04afb8809f8fb9405ea71d953a88b7;hp=1bfda6d47b9393985c58daa83b94475e5a34ee9a;hb=a145ef44f6e5c98992c30bdeb71cb28684e4e840;hpb=00e58ae439d91f37995d446bc6c743cc4b11343e diff --git a/lisp/nnoo.el b/lisp/nnoo.el index 1bfda6d47..8a360d9e1 100644 --- a/lisp/nnoo.el +++ b/lisp/nnoo.el @@ -1,7 +1,9 @@ ;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996,97 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen ;; 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,7 +61,7 @@ (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) @@ -88,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)) @@ -126,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))))) @@ -143,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) @@ -157,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) @@ -178,10 +203,12 @@ (nconc bvariables (list (cons (car def) (and (boundp (car def)) (symbol-value (car def))))))) - (set (car def) (cadr 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)))) @@ -192,7 +219,7 @@ (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 + ;; 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*") @@ -207,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))) @@ -274,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