Require cl when compile.
authormorioka <morioka>
Fri, 14 May 1999 11:02:32 +0000 (11:02 +0000)
committermorioka <morioka>
Fri, 14 May 1999 11:02:32 +0000 (11:02 +0000)
(luna-class-parents): New macro.
(luna-class-find-member): Search recursively.
(luna-class-find-function): Check fboundp.

luna.el

diff --git a/luna.el b/luna.el
index e4a36e2..6586c3a 100644 (file)
--- 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))