Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnoo.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents 0d2f883870bc
children fe104dbd9147
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
56 (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))
57 (setcar funcs (cons func (car funcs))))) 57 (setcar funcs (cons func (car funcs)))))
58 58
59 (defmacro nnoo-declare (backend &rest parents) 59 (defmacro nnoo-declare (backend &rest parents)
60 `(eval-and-compile 60 `(eval-and-compile
61 (push (list ',backend 61 (push (list ',backend
62 (mapcar (lambda (p) (list p)) ',parents) 62 (mapcar (lambda (p) (list p)) ',parents)
63 nil nil) 63 nil nil)
64 nnoo-definition-alist) 64 nnoo-definition-alist)
65 (push (list ',backend "*internal-non-initialized-backend*") 65 (push (list ',backend "*internal-non-initialized-backend*")
66 nnoo-state-alist))) 66 nnoo-state-alist)))
124 (incf i)) 124 (incf i))
125 (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) 125 (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
126 (&rest args) 126 (&rest args)
127 (nnoo-parent-function ',backend ',(car m) 127 (nnoo-parent-function ',backend ',(car m)
128 ,(cons 'list (nreverse margs)))))))) 128 ,(cons 'list (nreverse margs))))))))
129 129
130 (defun nnoo-backend (symbol) 130 (defun nnoo-backend (symbol)
131 (string-match "^[^-]+-" (symbol-name symbol)) 131 (string-match "^[^-]+-" (symbol-name symbol))
132 (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) 132 (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
133 133
134 (defun nnoo-rest-symbol (symbol) 134 (defun nnoo-rest-symbol (symbol)
178 (nconc bvariables 178 (nconc bvariables
179 (list (cons (car def) (and (boundp (car def)) 179 (list (cons (car def) (and (boundp (car def))
180 (symbol-value (car def))))))) 180 (symbol-value (car def)))))))
181 (set (car def) (cadr def)))) 181 (set (car def) (cadr def))))
182 (while parents 182 (while parents
183 (nnoo-change-server 183 (nnoo-change-server
184 (caar parents) server 184 (caar parents) server
185 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) 185 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
186 (cdar parents))) 186 (cdar parents)))
187 (pop parents)))) 187 (pop parents))))
188 t) 188 t)
189 189
190 (defun nnoo-push-server (backend current) 190 (defun nnoo-push-server (backend current)
191 (let ((bstate (assq backend nnoo-state-alist)) 191 (let ((bstate (assq backend nnoo-state-alist))
192 (defs (nnoo-variables backend))) 192 (defs (nnoo-variables backend)))
193 ;; Remove the old definition. 193 ;; Remove the old definition.
194 (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 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 196 ;; the nil server), then we update the default values of
197 ;; all the variables to reflect the current values. 197 ;; all the variables to reflect the current values.
198 (when (equal current "*internal-non-initialized-backend*") 198 (when (equal current "*internal-non-initialized-backend*")
199 (let ((defaults (nnoo-variables backend)) 199 (let ((defaults (nnoo-variables backend))
200 def) 200 def)