[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 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, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

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