X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnoo.el;h=21b17c344396990f50a6090b44e00fe79b21cc50;hb=8a2d8fc6cbd2eb883bf7da7307f2f53938a08077;hp=bede2f07efbf0fbef86a73ccf56e8b3f8c9d1d93;hpb=bd252d9de5a5cb84f6bb7e09986d4a5ff1b4f2b0;p=gnus diff --git a/lisp/nnoo.el b/lisp/nnoo.el index bede2f07e..21b17c344 100644 --- a/lisp/nnoo.el +++ b/lisp/nnoo.el @@ -1,7 +1,7 @@ ;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -26,10 +26,11 @@ ;;; 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." @@ -58,10 +59,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 +89,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 +144,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 +161,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 +175,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) @@ -176,10 +201,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)))) @@ -190,10 +217,10 @@ (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. - (unless current + (when (equal current "*internal-non-initialized-backend*") (let ((defaults (nnoo-variables backend)) def) (while (setq def (pop defaults)) @@ -205,8 +232,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))) @@ -263,7 +293,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))