From 88d09d2aa3f166e4c05e58cbd2cb4aa657e36861 Mon Sep 17 00:00:00 2001 From: morioka Date: Fri, 14 May 1999 11:02:32 +0000 Subject: [PATCH] Require cl when compile. (luna-class-parents): New macro. (luna-class-find-member): Search recursively. (luna-class-find-function): Check fboundp. --- luna.el | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/luna.el b/luna.el index e4a36e2..6586c3a 100644 --- a/luna.el +++ b/luna.el @@ -24,6 +24,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (defmacro luna-find-class (name) "Return the luna-class of the given NAME." `(get ,name 'luna-class)) @@ -34,6 +36,9 @@ (defmacro luna-class-obarray (class) `(aref ,class 1)) +(defmacro luna-class-parents (class) + `(aref ,class 2)) + (defmacro luna-class-number-of-slots (class) `(aref ,class 3)) @@ -105,7 +110,15 @@ It must be plist and each slot name must have prefix `:'." (defsubst luna-class-find-member (class member-name) (or (stringp member-name) (setq member-name (symbol-name member-name))) - (intern-soft member-name (luna-class-obarray class))) + (or (intern-soft member-name (luna-class-obarray class)) + (let ((parents (luna-class-parents class)) + ret) + (while (and parents + (null + (setq ret (luna-class-find-member + (luna-find-class (pop parents)) + member-name))))) + ret))) (defsubst luna-class-find-or-make-member (class member-name) (or (stringp member-name) @@ -141,8 +154,18 @@ specialized parameter. (car (car ARGS)) is name of variable and (nth (put 'luna-define-method 'lisp-indent-function 'defun) -(defmacro luna-class-find-function (class service) - `(symbol-function (luna-class-find-member ,class ,service))) +(defsubst luna-class-find-function (class service) + (let ((sym (luna-class-find-member class service))) + (if (fboundp sym) + (symbol-function sym) + (let ((parents (luna-class-parents class)) + ret) + (while (and parents + (null + (setq ret (luna-class-find-function + (luna-find-class (pop parents)) + service))))) + ret)))) (defmacro luna-find-function (entity service) `(luna-class-find-function (luna-find-class (luna-class-name ,entity)) -- 1.7.10.4