From: morioka <morioka>
Date: Fri, 14 May 1999 11:02:32 +0000 (+0000)
Subject: Require cl when compile.
X-Git-Tag: chao-1_13_0~57
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=88d09d2aa3f166e4c05e58cbd2cb4aa657e36861;p=elisp%2Fflim.git

Require cl when compile.
(luna-class-parents): New macro.
(luna-class-find-member): Search recursively.
(luna-class-find-function): Check fboundp.
---

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))