diff options
Diffstat (limited to 'lisp/nnoo.el')
| -rw-r--r-- | lisp/nnoo.el | 251 |
1 files changed, 0 insertions, 251 deletions
diff --git a/lisp/nnoo.el b/lisp/nnoo.el deleted file mode 100644 index cddba4ae564..00000000000 --- a/lisp/nnoo.el +++ /dev/null @@ -1,251 +0,0 @@ -;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> -;; 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 2, 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar nnoo-definition-alist nil) -(defvar nnoo-state-alist 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)) - (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) - "The same as `defun', only register FUNC." - `(prog1 - (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) - 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 - (push (list ',backend - (mapcar (lambda (p) (list p)) ',parents) - nil nil) - nnoo-definition-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))) - -(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) -(put 'nnoo-import 'lisp-indent-hook 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-change-server pbackend (nnoo-current-server backend) - (cdr (assq pbackend (nnoo-parents backend)))) - (apply function args))) - -(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) - (cdr (assq pbackend (nnoo-parents backend)))) - (apply function args))) - -(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) - (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))) - (sdefs (assq backend nnoo-definition-alist)) - (current (car bstate)) - (parents (nnoo-parents backend)) - state) - (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 defs - (set (caar defs) (cadar defs)) - (pop defs))) - (while parents - (nnoo-change-server - (caar parents) 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))) - (let (state) - (while defs - (push (cons (caar defs) (symbol-value (caar defs))) - state) - (pop defs)) - (nconc bstate (list (cons current state)))))) - -(defun nnoo-current-server-p (backend server) - (equal (nnoo-current-server backend) 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) - `(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)))) - -(provide 'nnoo) - -;;; nnoo.el ends here. |