X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnoo.el;h=083bedc6e19212c36ee91294b491a664f77c1f25;hp=58f4c0f59dcea3c81ef0e2832f80379e87138a5c;hb=c9a58d3bdde1e6a8d653c1126f807da23441e459;hpb=34be01cf143ec2638b057b4606dcc30cebdeea07 diff --git a/lisp/nnoo.el b/lisp/nnoo.el index 58f4c0f59..083bedc6e 100644 --- a/lisp/nnoo.el +++ b/lisp/nnoo.el @@ -1,15 +1,17 @@ ;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -17,29 +19,27 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; 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) -(put 'defvoo 'lisp-indent-hook 2) (put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map)) (defmacro deffoo (func args &rest forms) @@ -48,11 +48,10 @@ (defun ,func ,args ,@forms) (nnoo-register-function ',func))) (put 'deffoo 'lisp-indent-function 2) -(put 'deffoo 'lisp-indent-hook 2) (put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) (defun nnoo-register-function (func) - (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) + (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) nnoo-definition-alist)))) (unless funcs (error "%s belongs to a backend that hasn't been declared" func)) @@ -60,12 +59,17 @@ (defmacro nnoo-declare (backend &rest parents) `(eval-and-compile - (push (list ',backend - (mapcar (lambda (p) (list p)) ',parents) - nil nil) - nnoo-definition-alist))) + (if (assq ',backend nnoo-definition-alist) + (setcar (cdr (assq ',backend nnoo-definition-alist)) + (mapcar 'list ',parents)) + (push (list ',backend + (mapcar 'list ',parents) + nil nil) + nnoo-definition-alist)) + (unless (assq ',backend nnoo-state-alist) + (push (list ',backend "*internal-non-initialized-backend*") + nnoo-state-alist)))) (put 'nnoo-declare 'lisp-indent-function 1) -(put 'nnoo-declare 'lisp-indent-hook 1) (defun nnoo-parents (backend) (nth 1 (assoc backend nnoo-definition-alist))) @@ -79,7 +83,6 @@ (defmacro nnoo-import (backend &rest imports) `(nnoo-import-1 ',backend ',imports)) (put 'nnoo-import 'lisp-indent-function 1) -(put 'nnoo-import 'lisp-indent-hook 1) (defun nnoo-import-1 (backend imports) (let ((call-function @@ -90,30 +93,46 @@ (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)) (put 'nnoo-map-functions 'lisp-indent-function 1) -(put 'nnoo-map-functions 'lisp-indent-hook 1) (defun nnoo-map-functions-1 (backend maps) (let (m margs i) @@ -127,9 +146,9 @@ (incf i)) (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) (&rest args) - (nnoo-parent-function ',backend ',(car m) + (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))))) @@ -146,8 +165,8 @@ (def (assq backend nnoo-definition-alist)) (parents (nth 1 def))) (unless def - (error "%s belongs to a backend that hasn't been declared." var)) - (setcar (nthcdr 2 def) + (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) (cons (cons var (symbol-value var)) @@ -158,10 +177,15 @@ (defun nnoo-change-server (backend server defs) (let* ((bstate (cdr (assq backend nnoo-state-alist))) - (sdefs (assq backend nnoo-definition-alist)) (current (car bstate)) (parents (nnoo-parents backend)) - state) + (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,12 +200,17 @@ (pop state)) (setcar bstate server) (unless (cdr (assoc server (cddr bstate))) - (while defs - (set (caar defs) (cadar defs)) - (pop defs))) + (while (setq def (pop defs)) + (unless (assq (car def) bvariables) + (nconc bvariables + (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)))) @@ -192,6 +221,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))) @@ -199,8 +236,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))) @@ -241,7 +281,7 @@ (defun nnoo-define-basics-1 (backend) (let ((functions '(close-server server-opened status-message))) (while functions - (eval `(deffoo ,(nnoo-symbol backend (car functions)) + (eval `(deffoo ,(nnoo-symbol backend (car functions)) (&optional server) (,(nnoo-symbol 'nnoo (pop functions)) ',backend server))))) (eval `(deffoo ,(nnoo-symbol backend 'open-server) @@ -256,15 +296,30 @@ All functions will return nil and report an error." (defun nnoo-define-skeleton-1 (backend) (let ((functions '(retrieve-headers - request-close server-opened request-article - open-group request-group close-group - request-list request-post)) - function) + request-close request-article + request-group close-group + request-list request-post request-list-newsgroups)) + function fun) (while (setq function (pop functions)) - (eval `(deffoo ,(nnoo-symbol backend function) - (&optional server) - (nnheader-report ',backend ,(format "%s-%s not implemented" - backend function))))))) + (when (not (fboundp (setq fun (nnoo-symbol backend function)))) + (eval `(deffoo ,fun + (&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