[bpt/emacs.git] / lisp / gnus / nnoo.el

;;; nnoo.el --- OO Gnus Backends

;; 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 <larsi@gnus.org>
;; Keywords: news

;; This file is part of GNU Emacs.

;; 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 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(require 'nnheader)
(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 ,(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 'edebug-form-spec '(var init &optional doc &rest map))

(defmacro deffoo (func args &rest forms)
  "The same as `defun', only register FUNC."
  `(prog1
       (defun ,func ,args ,@forms)
     (nnoo-register-function ',func)))
(put 'deffoo 'lisp-indent-function 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)
				nnoo-definition-alist))))
    (unless funcs
      (error "%s belongs to a backend that hasn't been declared" func))
    (setcar funcs (cons func (car funcs)))))

(defmacro nnoo-declare (backend &rest parents)
  `(eval-and-compile
     (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)

(defun nnoo-parents (backend)
  (nth 1 (assoc backend nnoo-definition-alist)))

(defun nnoo-variables (backend)
  (nth 2 (assoc backend nnoo-definition-alist)))

(defun nnoo-functions (backend)
  (nth 3 (assoc backend nnoo-definition-alist)))

(defmacro nnoo-import (backend &rest imports)
  `(nnoo-import-1 ',backend ',imports))
(put 'nnoo-import 'lisp-indent-function 1)

(defun nnoo-import-1 (backend imports)
  (let ((call-function
	 (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
	imp functions function)
    (while (setq imp (pop imports))
      (setq functions
	    (or (cdr imp)
		(nnoo-functions (car imp))))
      (while 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-parent-backend backend))
    (nnoo-change-server pbackend
			(nnoo-current-server backend)
			(cdr (assq pbackend (nnoo-parents backend))))
    (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-parent-backend backend))
    (nnoo-change-server pbackend
			(nnoo-current-server backend)
			(cdr (assq pbackend (nnoo-parents backend))))
    (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)

(defun nnoo-map-functions-1 (backend maps)
  (let (m margs i)
    (while (setq m (pop maps))
      (setq i 0
	    margs nil)
      (while (< i (length (cdr m)))
	(if (numberp (nth i (cdr m)))
	    (push `(nth ,i args) margs)
	  (push (nth i (cdr m)) margs))
	(incf i))
      (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
		 (&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)))))

(defun nnoo-rest-symbol (symbol)
  (string-match "^[^-]+-" (symbol-name symbol))
  (intern (substring (symbol-name symbol) (match-end 0))))

(defun nnoo-symbol (backend symbol)
  (intern (format "%s-%s" backend symbol)))

(defun nnoo-define (var map)
  (let* ((backend (nnoo-backend var))
	 (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)
	    (delq (assq var (nth 2 def)) (nth 2 def)))
    (setcar (nthcdr 2 def)
	    (cons (cons var (symbol-value var))
		  (nth 2 def)))
    (while map
      (nconc (assq (nnoo-backend (car map)) parents)
	     (list (list (pop map) var))))))

(defun nnoo-change-server (backend server defs)
  (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)
      (pop bstate))
    (if (equal server current)
	t
      (nnoo-push-server backend current)
      (setq state (or (cdr (assoc server (cddr bstate)))
		      (nnoo-variables backend)))
      (while state
	(set (caar state) (cdar state))
	(pop state))
      (setcar bstate server)
      (unless (cdr (assoc server (cddr bstate)))
	(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) (format "%s+%s" backend server)
	 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
		 (cdar parents)))
	(pop parents))))
  t)

(defun nnoo-push-server (backend current)
  (let ((bstate (assq backend nnoo-state-alist))
	(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)))
	      state)
	(pop defs))
      (nconc bstate (list (cons current state))))))

(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)))

(defun nnoo-close-server (backend &optional server)
  (unless server
    (setq server (nnoo-current-server backend)))
  (when server
    (let* ((bstate (cdr (assq backend nnoo-state-alist)))
	   (defs (assoc server (cdr bstate))))
      (when bstate
	(setcar bstate nil)
	(setcdr bstate (delq defs (cdr bstate)))
	(pop defs)
	(while defs
	  (set (car (pop defs)) nil)))))
  t)

(defun nnoo-close (backend)
  (setq nnoo-state-alist
	(delq (assq backend nnoo-state-alist)
	      nnoo-state-alist))
  t)

(defun nnoo-status-message (backend server)
  (nnheader-get-report backend))

(defun nnoo-server-opened (backend server)
  (and (nnoo-current-server-p backend server)
       nntp-server-buffer
       (buffer-name nntp-server-buffer)))

(defmacro nnoo-define-basics (backend)
  "Define `close-server', `server-opened' and `status-message'."
  `(eval-and-compile
     (nnoo-define-basics-1 ',backend)))

(defun nnoo-define-basics-1 (backend)
  (let ((functions '(close-server server-opened status-message)))
    (while functions
      (eval `(deffoo ,(nnoo-symbol backend (car functions))
		 (&optional server)
	       (,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
  (eval `(deffoo ,(nnoo-symbol backend 'open-server)
	     (server &optional defs)
	   (nnoo-change-server ',backend server defs))))

(defmacro nnoo-define-skeleton (backend)
  "Define all required backend functions for BACKEND.
All functions will return nil and report an error."
  `(eval-and-compile
     (nnoo-define-skeleton-1 ',backend)))

(defun nnoo-define-skeleton-1 (backend)
  (let ((functions '(retrieve-headers
		     request-close request-article
		     request-group close-group
		     request-list request-post request-list-newsgroups))
	function fun)
    (while (setq function (pop functions))
      (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)

;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7
;;; nnoo.el ends here
Commit	Line	Data
eec82323	1	;;; nnoo.el --- OO Gnus Backends
16409b0b	2
e84b4b86	3	;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
114f9c96	4	;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
eec82323	5
6748645f	6	;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323 LMI	7	;; Keywords: news
	8
	9	;; This file is part of GNU Emacs.
	10
5e809f55	11	;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323	12	;; it under the terms of the GNU General Public License as published by
5e809f55 GM	13	;; the Free Software Foundation, either version 3 of the License, or
5e809f55 GM	14	;; (at your option) any later version.
eec82323 LMI	15
	16	;; GNU Emacs is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
5e809f55	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323 LMI	23
	24	;;; Commentary:
	25
	26	;;; Code:
	27
	28	(require 'nnheader)
349f4e97	29	(eval-when-compile (require 'cl))
eec82323 LMI	30
	31	(defvar nnoo-definition-alist nil)
	32	(defvar nnoo-state-alist nil)
6748645f	33	(defvar nnoo-parent-backend nil)
eec82323 LMI	34
	35	(defmacro defvoo (var init &optional doc &rest map)
	36	"The same as `defvar', only takes list of variables to MAP to."
	37	`(prog1
	38	,(if doc
23f87bed	39	`(defvar ,var ,init ,(concat doc "\n\nThis is a Gnus server variable. See Info node `(gnus)Select Methods'."))
eec82323 LMI	40	`(defvar ,var ,init))
	41	(nnoo-define ',var ',map)))
	42	(put 'defvoo 'lisp-indent-function 2)
	43	(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
	44
	45	(defmacro deffoo (func args &rest forms)
	46	"The same as `defun', only register FUNC."
	47	`(prog1
	48	(defun ,func ,args ,@forms)
	49	(nnoo-register-function ',func)))
	50	(put 'deffoo 'lisp-indent-function 2)
	51	(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
	52
	53	(defun nnoo-register-function (func)
	54	(let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
	55	nnoo-definition-alist))))
	56	(unless funcs
	57	(error "%s belongs to a backend that hasn't been declared" func))
	58	(setcar funcs (cons func (car funcs)))))
	59
	60	(defmacro nnoo-declare (backend &rest parents)
	61	`(eval-and-compile
cf5a5c38 MB	62	(if (assq ',backend nnoo-definition-alist)
	63	(setcar (cdr (assq ',backend nnoo-definition-alist))
	64	(mapcar 'list ',parents))
	65	(push (list ',backend
	66	(mapcar 'list ',parents)
	67	nil nil)
	68	nnoo-definition-alist))
	69	(unless (assq ',backend nnoo-state-alist)
	70	(push (list ',backend "internal-non-initialized-backend")
	71	nnoo-state-alist))))
eec82323 LMI	72	(put 'nnoo-declare 'lisp-indent-function 1)
	73
	74	(defun nnoo-parents (backend)
	75	(nth 1 (assoc backend nnoo-definition-alist)))
	76
	77	(defun nnoo-variables (backend)
	78	(nth 2 (assoc backend nnoo-definition-alist)))
	79
	80	(defun nnoo-functions (backend)
	81	(nth 3 (assoc backend nnoo-definition-alist)))
	82
	83	(defmacro nnoo-import (backend &rest imports)
	84	`(nnoo-import-1 ',backend ',imports))
	85	(put 'nnoo-import 'lisp-indent-function 1)
	86
	87	(defun nnoo-import-1 (backend imports)
	88	(let ((call-function
	89	(if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
	90	imp functions function)
	91	(while (setq imp (pop imports))
	92	(setq functions
	93	(or (cdr imp)
	94	(nnoo-functions (car imp))))
	95	(while functions
6748645f LMI	96	(unless (fboundp
	97	(setq function
	98	(nnoo-symbol backend
	99	(nnoo-rest-symbol (car functions)))))
eec82323 LMI	100	(eval `(deffoo ,function (&rest args)
	101	(,call-function ',backend ',(car functions) args))))
	102	(pop functions)))))
	103
	104	(defun nnoo-parent-function (backend function args)
6748645f LMI	105	(let ((pbackend (nnoo-backend function))
	106	(nnoo-parent-backend backend))
	107	(nnoo-change-server pbackend
	108	(nnoo-current-server backend)
eec82323	109	(cdr (assq pbackend (nnoo-parents backend))))
6748645f LMI	110	(prog1
6748645f LMI	111	(apply function args)
16409b0b GM	112	;; Copy the changed variables back into the child.
	113	(let ((vars (cdr (assq pbackend (nnoo-parents backend)))))
	114	(while vars
	115	(set (cadar vars) (symbol-value (caar vars)))
	116	(setq vars (cdr vars)))))))
eec82323 LMI	117
	118	(defun nnoo-execute (backend function &rest args)
	119	"Execute FUNCTION on behalf of BACKEND."
6748645f LMI	120	(let ((pbackend (nnoo-backend function))
	121	(nnoo-parent-backend backend))
	122	(nnoo-change-server pbackend
	123	(nnoo-current-server backend)
eec82323	124	(cdr (assq pbackend (nnoo-parents backend))))
6748645f LMI	125	(prog1
	126	(apply function args)
	127	;; Copy the changed variables back into the child.
	128	(let ((vars (cdr (assq pbackend (nnoo-parents backend)))))
	129	(while vars
	130	(set (cadar vars) (symbol-value (caar vars)))
	131	(setq vars (cdr vars)))))))
eec82323 LMI	132
	133	(defmacro nnoo-map-functions (backend &rest maps)
	134	`(nnoo-map-functions-1 ',backend ',maps))
	135	(put 'nnoo-map-functions 'lisp-indent-function 1)
	136
	137	(defun nnoo-map-functions-1 (backend maps)
	138	(let (m margs i)
	139	(while (setq m (pop maps))
	140	(setq i 0
	141	margs nil)
	142	(while (< i (length (cdr m)))
	143	(if (numberp (nth i (cdr m)))
	144	(push `(nth ,i args) margs)
	145	(push (nth i (cdr m)) margs))
	146	(incf i))
	147	(eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
	148	(&rest args)
	149	(nnoo-parent-function ',backend ',(car m)
	150	,(cons 'list (nreverse margs))))))))
	151
	152	(defun nnoo-backend (symbol)
	153	(string-match "^[^-]+-" (symbol-name symbol))
	154	(intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
	155
	156	(defun nnoo-rest-symbol (symbol)
	157	(string-match "^[^-]+-" (symbol-name symbol))
	158	(intern (substring (symbol-name symbol) (match-end 0))))
	159
	160	(defun nnoo-symbol (backend symbol)
	161	(intern (format "%s-%s" backend symbol)))
	162
	163	(defun nnoo-define (var map)
	164	(let* ((backend (nnoo-backend var))
	165	(def (assq backend nnoo-definition-alist))
	166	(parents (nth 1 def)))
	167	(unless def
a8151ef7	168	(error "%s belongs to a backend that hasn't been declared" var))
eec82323 LMI	169	(setcar (nthcdr 2 def)
	170	(delq (assq var (nth 2 def)) (nth 2 def)))
	171	(setcar (nthcdr 2 def)
	172	(cons (cons var (symbol-value var))
	173	(nth 2 def)))
	174	(while map
	175	(nconc (assq (nnoo-backend (car map)) parents)
	176	(list (list (pop map) var))))))
	177
	178	(defun nnoo-change-server (backend server defs)
	179	(let* ((bstate (cdr (assq backend nnoo-state-alist)))
	180	(current (car bstate))
	181	(parents (nnoo-parents backend))
6748645f LMI	182	(server (if nnoo-parent-backend
	183	(format "%s+%s" nnoo-parent-backend server)
	184	server))
eec82323 LMI	185	(bvariables (nnoo-variables backend))
eec82323 LMI	186	state def)
6748645f LMI	187	;; If we don't have a current state, we push an empty state
6748645f LMI	188	;; onto the alist.
eec82323 LMI	189	(unless bstate
	190	(push (setq bstate (list backend nil))
	191	nnoo-state-alist)
	192	(pop bstate))
	193	(if (equal server current)
	194	t
	195	(nnoo-push-server backend current)
	196	(setq state (or (cdr (assoc server (cddr bstate)))
	197	(nnoo-variables backend)))
	198	(while state
	199	(set (caar state) (cdar state))
	200	(pop state))
	201	(setcar bstate server)
	202	(unless (cdr (assoc server (cddr bstate)))
	203	(while (setq def (pop defs))
	204	(unless (assq (car def) bvariables)
	205	(nconc bvariables
23f87bed MB	206	(list (cons (car def) (and (boundp (car def))
23f87bed MB	207	(symbol-value (car def)))))))
6748645f LMI	208	(if (equal server "internal-non-initialized-backend")
	209	(set (car def) (symbol-value (cadr def)))
	210	(set (car def) (cadr def)))))
eec82323 LMI	211	(while parents
eec82323 LMI	212	(nnoo-change-server
6748645f	213	(caar parents) (format "%s+%s" backend server)
eec82323 LMI	214	(mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
	215	(cdar parents)))
	216	(pop parents))))
	217	t)
	218
	219	(defun nnoo-push-server (backend current)
	220	(let ((bstate (assq backend nnoo-state-alist))
	221	(defs (nnoo-variables backend)))
	222	;; Remove the old definition.
	223	(setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
	224	;; If this is the first time we push the server (i. e., this is
	225	;; the nil server), then we update the default values of
	226	;; all the variables to reflect the current values.
	227	(when (equal current "internal-non-initialized-backend")
	228	(let ((defaults (nnoo-variables backend))
	229	def)
	230	(while (setq def (pop defaults))
	231	(setcdr def (symbol-value (car def))))))
	232	(let (state)
	233	(while defs
	234	(push (cons (caar defs) (symbol-value (caar defs)))
	235	state)
	236	(pop defs))
	237	(nconc bstate (list (cons current state))))))
	238
	239	(defsubst nnoo-current-server-p (backend server)
6748645f LMI	240	(equal (nnoo-current-server backend)
	241	(if nnoo-parent-backend
	242	(format "%s+%s" nnoo-parent-backend server)
	243	server)))
eec82323 LMI	244
	245	(defun nnoo-current-server (backend)
	246	(nth 1 (assq backend nnoo-state-alist)))
	247
	248	(defun nnoo-close-server (backend &optional server)
	249	(unless server
	250	(setq server (nnoo-current-server backend)))
	251	(when server
	252	(let* ((bstate (cdr (assq backend nnoo-state-alist)))
	253	(defs (assoc server (cdr bstate))))
	254	(when bstate
	255	(setcar bstate nil)
	256	(setcdr bstate (delq defs (cdr bstate)))
	257	(pop defs)
	258	(while defs
e84b4b86	259	(set (car (pop defs)) nil)))))
eec82323 LMI	260	t)
	261
	262	(defun nnoo-close (backend)
	263	(setq nnoo-state-alist
	264	(delq (assq backend nnoo-state-alist)
	265	nnoo-state-alist))
	266	t)
	267
	268	(defun nnoo-status-message (backend server)
	269	(nnheader-get-report backend))
	270
	271	(defun nnoo-server-opened (backend server)
	272	(and (nnoo-current-server-p backend server)
	273	nntp-server-buffer
	274	(buffer-name nntp-server-buffer)))
	275
	276	(defmacro nnoo-define-basics (backend)
	277	"Define `close-server', `server-opened' and `status-message'."
	278	`(eval-and-compile
	279	(nnoo-define-basics-1 ',backend)))
	280
	281	(defun nnoo-define-basics-1 (backend)
	282	(let ((functions '(close-server server-opened status-message)))
	283	(while functions
	284	(eval `(deffoo ,(nnoo-symbol backend (car functions))
	285	(&optional server)
	286	(,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
	287	(eval `(deffoo ,(nnoo-symbol backend 'open-server)
	288	(server &optional defs)
	289	(nnoo-change-server ',backend server defs))))
	290
	291	(defmacro nnoo-define-skeleton (backend)
	292	"Define all required backend functions for BACKEND.
	293	All functions will return nil and report an error."
	294	`(eval-and-compile
	295	(nnoo-define-skeleton-1 ',backend)))
	296
	297	(defun nnoo-define-skeleton-1 (backend)
	298	(let ((functions '(retrieve-headers
	299	request-close request-article
	300	request-group close-group
	301	request-list request-post request-list-newsgroups))
	302	function fun)
	303	(while (setq function (pop functions))
	304	(when (not (fboundp (setq fun (nnoo-symbol backend function))))
	305	(eval `(deffoo ,fun
	306	(&rest args)
	307	(nnheader-report ',backend ,(format "%s-%s not implemented"
	308	backend function))))))))
23f87bed MB	309
	310	(defun nnoo-set (server &rest args)
	311	(let ((parents (nnoo-parents (car server)))
	312	(nnoo-parent-backend (car server)))
	313	(while parents
	314	(nnoo-change-server (caar parents)
	315	(cadr server)
	316	(cdar parents))
	317	(pop parents)))
	318	(nnoo-change-server (car server)
	319	(cadr server) (cddr server))
	320	(while args
	321	(set (pop args) (pop args))))
	322
eec82323 LMI	323	(provide 'nnoo)
eec82323 LMI	324
cbee283d	325	;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7
715a2ca2	326	;;; nnoo.el ends here