Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnoo.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 376386a54a3c
children ec9a17fef872
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; nnoo.el --- OO Gnus Backends 1 ;;; nnoo.el --- OO Gnus Backends
2 ;; Copyright (C) 1996 Free Software Foundation, Inc. 2 ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Keywords: news 5 ;; Keywords: news
6 6
7 ;; This file is part of GNU Emacs. 7 ;; This file is part of GNU Emacs.
23 23
24 ;;; Commentary: 24 ;;; Commentary:
25 25
26 ;;; Code: 26 ;;; Code:
27 27
28 (eval-when-compile (require 'cl)) 28 (require 'nnheader)
29 (require 'cl)
29 30
30 (defvar nnoo-definition-alist nil) 31 (defvar nnoo-definition-alist nil)
31 (defvar nnoo-state-alist nil) 32 (defvar nnoo-state-alist nil)
32 33
33 (defmacro defvoo (var init &optional doc &rest map) 34 (defmacro defvoo (var init &optional doc &rest map)
36 ,(if doc 37 ,(if doc
37 `(defvar ,var ,init ,doc) 38 `(defvar ,var ,init ,doc)
38 `(defvar ,var ,init)) 39 `(defvar ,var ,init))
39 (nnoo-define ',var ',map))) 40 (nnoo-define ',var ',map)))
40 (put 'defvoo 'lisp-indent-function 2) 41 (put 'defvoo 'lisp-indent-function 2)
41 (put 'defvoo 'lisp-indent-hook 2)
42 (put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map)) 42 (put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
43 43
44 (defmacro deffoo (func args &rest forms) 44 (defmacro deffoo (func args &rest forms)
45 "The same as `defun', only register FUNC." 45 "The same as `defun', only register FUNC."
46 `(prog1 46 `(prog1
47 (defun ,func ,args ,@forms) 47 (defun ,func ,args ,@forms)
48 (nnoo-register-function ',func))) 48 (nnoo-register-function ',func)))
49 (put 'deffoo 'lisp-indent-function 2) 49 (put 'deffoo 'lisp-indent-function 2)
50 (put 'deffoo 'lisp-indent-hook 2)
51 (put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) 50 (put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
52 51
53 (defun nnoo-register-function (func) 52 (defun nnoo-register-function (func)
54 (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) 53 (let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
55 nnoo-definition-alist)))) 54 nnoo-definition-alist))))
56 (unless funcs 55 (unless funcs
57 (error "%s belongs to a backend that hasn't been declared" func)) 56 (error "%s belongs to a backend that hasn't been declared" func))
58 (setcar funcs (cons func (car funcs))))) 57 (setcar funcs (cons func (car funcs)))))
59 58
60 (defmacro nnoo-declare (backend &rest parents) 59 (defmacro nnoo-declare (backend &rest parents)
61 `(eval-and-compile 60 `(eval-and-compile
62 (push (list ',backend 61 (push (list ',backend
63 (mapcar (lambda (p) (list p)) ',parents) 62 (mapcar (lambda (p) (list p)) ',parents)
64 nil nil) 63 nil nil)
65 nnoo-definition-alist))) 64 nnoo-definition-alist)
65 (push (list ',backend "*internal-non-initialized-backend*")
66 nnoo-state-alist)))
66 (put 'nnoo-declare 'lisp-indent-function 1) 67 (put 'nnoo-declare 'lisp-indent-function 1)
67 (put 'nnoo-declare 'lisp-indent-hook 1)
68 68
69 (defun nnoo-parents (backend) 69 (defun nnoo-parents (backend)
70 (nth 1 (assoc backend nnoo-definition-alist))) 70 (nth 1 (assoc backend nnoo-definition-alist)))
71 71
72 (defun nnoo-variables (backend) 72 (defun nnoo-variables (backend)
76 (nth 3 (assoc backend nnoo-definition-alist))) 76 (nth 3 (assoc backend nnoo-definition-alist)))
77 77
78 (defmacro nnoo-import (backend &rest imports) 78 (defmacro nnoo-import (backend &rest imports)
79 `(nnoo-import-1 ',backend ',imports)) 79 `(nnoo-import-1 ',backend ',imports))
80 (put 'nnoo-import 'lisp-indent-function 1) 80 (put 'nnoo-import 'lisp-indent-function 1)
81 (put 'nnoo-import 'lisp-indent-hook 1)
82 81
83 (defun nnoo-import-1 (backend imports) 82 (defun nnoo-import-1 (backend imports)
84 (let ((call-function 83 (let ((call-function
85 (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function)) 84 (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
86 imp functions function) 85 imp functions function)
89 (or (cdr imp) 88 (or (cdr imp)
90 (nnoo-functions (car imp)))) 89 (nnoo-functions (car imp))))
91 (while functions 90 (while functions
92 (unless (fboundp (setq function 91 (unless (fboundp (setq function
93 (nnoo-symbol backend (nnoo-rest-symbol 92 (nnoo-symbol backend (nnoo-rest-symbol
94 (car functions))))) 93 (car functions)))))
95 (eval `(deffoo ,function (&rest args) 94 (eval `(deffoo ,function (&rest args)
96 (,call-function ',backend ',(car functions) args)))) 95 (,call-function ',backend ',(car functions) args))))
97 (pop functions))))) 96 (pop functions)))))
98 97
99 (defun nnoo-parent-function (backend function args) 98 (defun nnoo-parent-function (backend function args)
110 (apply function args))) 109 (apply function args)))
111 110
112 (defmacro nnoo-map-functions (backend &rest maps) 111 (defmacro nnoo-map-functions (backend &rest maps)
113 `(nnoo-map-functions-1 ',backend ',maps)) 112 `(nnoo-map-functions-1 ',backend ',maps))
114 (put 'nnoo-map-functions 'lisp-indent-function 1) 113 (put 'nnoo-map-functions 'lisp-indent-function 1)
115 (put 'nnoo-map-functions 'lisp-indent-hook 1)
116 114
117 (defun nnoo-map-functions-1 (backend maps) 115 (defun nnoo-map-functions-1 (backend maps)
118 (let (m margs i) 116 (let (m margs i)
119 (while (setq m (pop maps)) 117 (while (setq m (pop maps))
120 (setq i 0 118 (setq i 0
124 (push `(nth ,i args) margs) 122 (push `(nth ,i args) margs)
125 (push (nth i (cdr m)) margs)) 123 (push (nth i (cdr m)) margs))
126 (incf i)) 124 (incf i))
127 (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) 125 (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
128 (&rest args) 126 (&rest args)
129 (nnoo-parent-function ',backend ',(car m) 127 (nnoo-parent-function ',backend ',(car m)
130 ,(cons 'list (nreverse margs)))))))) 128 ,(cons 'list (nreverse margs))))))))
131 129
132 (defun nnoo-backend (symbol) 130 (defun nnoo-backend (symbol)
133 (string-match "^[^-]+-" (symbol-name symbol)) 131 (string-match "^[^-]+-" (symbol-name symbol))
134 (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) 132 (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
144 (let* ((backend (nnoo-backend var)) 142 (let* ((backend (nnoo-backend var))
145 (def (assq backend nnoo-definition-alist)) 143 (def (assq backend nnoo-definition-alist))
146 (parents (nth 1 def))) 144 (parents (nth 1 def)))
147 (unless def 145 (unless def
148 (error "%s belongs to a backend that hasn't been declared." var)) 146 (error "%s belongs to a backend that hasn't been declared." var))
149 (setcar (nthcdr 2 def) 147 (setcar (nthcdr 2 def)
150 (delq (assq var (nth 2 def)) (nth 2 def))) 148 (delq (assq var (nth 2 def)) (nth 2 def)))
151 (setcar (nthcdr 2 def) 149 (setcar (nthcdr 2 def)
152 (cons (cons var (symbol-value var)) 150 (cons (cons var (symbol-value var))
153 (nth 2 def))) 151 (nth 2 def)))
154 (while map 152 (while map
155 (nconc (assq (nnoo-backend (car map)) parents) 153 (nconc (assq (nnoo-backend (car map)) parents)
156 (list (list (pop map) var)))))) 154 (list (list (pop map) var))))))
157 155
158 (defun nnoo-change-server (backend server defs) 156 (defun nnoo-change-server (backend server defs)
159 (let* ((bstate (cdr (assq backend nnoo-state-alist))) 157 (let* ((bstate (cdr (assq backend nnoo-state-alist)))
160 (sdefs (assq backend nnoo-definition-alist))
161 (current (car bstate)) 158 (current (car bstate))
162 (parents (nnoo-parents backend)) 159 (parents (nnoo-parents backend))
163 state) 160 (bvariables (nnoo-variables backend))
161 state def)
164 (unless bstate 162 (unless bstate
165 (push (setq bstate (list backend nil)) 163 (push (setq bstate (list backend nil))
166 nnoo-state-alist) 164 nnoo-state-alist)
167 (pop bstate)) 165 (pop bstate))
168 (if (equal server current) 166 (if (equal server current)
173 (while state 171 (while state
174 (set (caar state) (cdar state)) 172 (set (caar state) (cdar state))
175 (pop state)) 173 (pop state))
176 (setcar bstate server) 174 (setcar bstate server)
177 (unless (cdr (assoc server (cddr bstate))) 175 (unless (cdr (assoc server (cddr bstate)))
178 (while defs 176 (while (setq def (pop defs))
179 (set (caar defs) (cadar defs)) 177 (unless (assq (car def) bvariables)
180 (pop defs))) 178 (nconc bvariables
179 (list (cons (car def) (and (boundp (car def))
180 (symbol-value (car def)))))))
181 (set (car def) (cadr def))))
181 (while parents 182 (while parents
182 (nnoo-change-server 183 (nnoo-change-server
183 (caar parents) server 184 (caar parents) server
184 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) 185 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
185 (cdar parents))) 186 (cdar parents)))
189 (defun nnoo-push-server (backend current) 190 (defun nnoo-push-server (backend current)
190 (let ((bstate (assq backend nnoo-state-alist)) 191 (let ((bstate (assq backend nnoo-state-alist))
191 (defs (nnoo-variables backend))) 192 (defs (nnoo-variables backend)))
192 ;; Remove the old definition. 193 ;; Remove the old definition.
193 (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) 194 (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
195 ;; If this is the first time we push the server (i. e., this is
196 ;; the nil server), then we update the default values of
197 ;; all the variables to reflect the current values.
198 (when (equal current "*internal-non-initialized-backend*")
199 (let ((defaults (nnoo-variables backend))
200 def)
201 (while (setq def (pop defaults))
202 (setcdr def (symbol-value (car def))))))
194 (let (state) 203 (let (state)
195 (while defs 204 (while defs
196 (push (cons (caar defs) (symbol-value (caar defs))) 205 (push (cons (caar defs) (symbol-value (caar defs)))
197 state) 206 state)
198 (pop defs)) 207 (pop defs))
231 (and (nnoo-current-server-p backend server) 240 (and (nnoo-current-server-p backend server)
232 nntp-server-buffer 241 nntp-server-buffer
233 (buffer-name nntp-server-buffer))) 242 (buffer-name nntp-server-buffer)))
234 243
235 (defmacro nnoo-define-basics (backend) 244 (defmacro nnoo-define-basics (backend)
245 "Define `close-server', `server-opened' and `status-message'."
236 `(eval-and-compile 246 `(eval-and-compile
237 (nnoo-define-basics-1 ',backend))) 247 (nnoo-define-basics-1 ',backend)))
238 248
239 (defun nnoo-define-basics-1 (backend) 249 (defun nnoo-define-basics-1 (backend)
240 (let ((functions '(close-server server-opened status-message))) 250 (let ((functions '(close-server server-opened status-message)))
241 (while functions 251 (while functions
242 (eval `(deffoo ,(nnoo-symbol backend (car functions)) 252 (eval `(deffoo ,(nnoo-symbol backend (car functions))
243 (&optional server) 253 (&optional server)
244 (,(nnoo-symbol 'nnoo (pop functions)) ',backend server))))) 254 (,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
245 (eval `(deffoo ,(nnoo-symbol backend 'open-server) 255 (eval `(deffoo ,(nnoo-symbol backend 'open-server)
246 (server &optional defs) 256 (server &optional defs)
247 (nnoo-change-server ',backend server defs)))) 257 (nnoo-change-server ',backend server defs))))
248 258
259 (defmacro nnoo-define-skeleton (backend)
260 "Define all required backend functions for BACKEND.
261 All functions will return nil and report an error."
262 `(eval-and-compile
263 (nnoo-define-skeleton-1 ',backend)))
264
265 (defun nnoo-define-skeleton-1 (backend)
266 (let ((functions '(retrieve-headers
267 request-close request-article
268 request-group close-group
269 request-list request-post request-list-newsgroups))
270 function fun)
271 (while (setq function (pop functions))
272 (when (not (fboundp (setq fun (nnoo-symbol backend function))))
273 (eval `(deffoo ,fun
274 (&rest args)
275 (nnheader-report ',backend ,(format "%s-%s not implemented"
276 backend function))))))))
249 (provide 'nnoo) 277 (provide 'nnoo)
250 278
251 ;;; nnoo.el ends here. 279 ;;; nnoo.el ends here.