X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=luna.el;h=f3504a6bc15b33746f96f45733dde7f355c07658;hb=0f0317cf179760a10043565f80f31853a6161bff;hp=be308b65a291c2f590b46d0d164c80d5b527bc52;hpb=bd99e0783ea309893f560eacfadb97d22cbe3446;p=elisp%2Fflim.git

diff --git a/luna.el b/luna.el
index be308b6..f3504a6 100644
--- a/luna.el
+++ b/luna.el
@@ -77,13 +77,14 @@ If SLOTS is specified, TYPE will be defined to have them."
     (while rest
       (setq parent (pop rest)
 	    b (- i 2))
-      (mapatoms (lambda (sym)
-		  (when (setq j (get sym 'luna-slot-index))
-		    (setq name (symbol-name sym))
-		    (unless (intern-soft name oa)
-		      (put (intern name oa) 'luna-slot-index (+ j b))
-		      (setq i (1+ i))
-		      )))
+      (mapatoms (function
+		 (lambda (sym)
+		   (when (setq j (get sym 'luna-slot-index))
+		     (setq name (symbol-name sym))
+		     (unless (intern-soft name oa)
+		       (put (intern name oa) 'luna-slot-index (+ j b))
+		       (setq i (1+ i))
+		       ))))
 		(luna-class-obarray (luna-find-class parent)))
       )
     (setq rest slots)
@@ -158,10 +159,11 @@ BODY is the body of method."
     (setq specializer (car args)
 	  class (nth 1 specializer)
 	  self (car specializer))
-    (` (let ((func (lambda (, (if self
-				  (cons self (cdr args))
-				(cdr args)))
-		     (,@ definition)))
+    (` (let ((func (function
+		    (lambda (, (if self
+				   (cons self (cdr args))
+				 (cdr args)))
+		      (,@ definition))))
 	     (sym (luna-class-find-or-make-member
 		   (luna-find-class '(, class)) '(, name))))
 	 (fset sym func)
@@ -291,15 +293,15 @@ It must be plist and each slot name must have prefix `:'."
   "Define generic-function NAME.
 ARGS is argument of and DOC is DOC-string."
   (if doc
-      `(defun ,(intern (symbol-name name)) ,args
-	 ,doc
-	 (luna-send ,(car args) ',name
-		    ,@(luna-arglist-to-arguments args))
-	 )
-    `(defun ,(intern (symbol-name name)) ,args
-       (luna-send ,(car args) ',name
-		  ,@(luna-arglist-to-arguments args))
-       )))
+      (` (defun (, (intern (symbol-name name))) (, args)
+	   (, doc)
+	   (luna-send (, (car args)) '(, name)
+		      (,@ (luna-arglist-to-arguments args)))
+	   ))
+    (` (defun (, (intern (symbol-name name))) (, args)
+	 (luna-send (, (car args)) '(, name)
+		    (,@ (luna-arglist-to-arguments args)))
+	 ))))
 
 (put 'luna-define-generic 'lisp-indent-function 'defun)
 
@@ -308,34 +310,35 @@ ARGS is argument of and DOC is DOC-string."
   (let ((entity-class (luna-find-class class-name))
 	parents parent-class)
     (mapatoms
-     (lambda (slot)
-       (if (luna-class-slot-index entity-class slot)
-	   (catch 'derived
-	     (setq parents (luna-class-parents entity-class))
-	     (while parents
-	       (setq parent-class (luna-find-class (car parents)))
-	       (if (luna-class-slot-index parent-class slot)
-		   (throw 'derived nil))
-	       (setq parents (cdr parents))
-	       )
-	     (eval
-	      `(progn
-		 (defmacro ,(intern (format "%s-%s-internal"
-					    class-name slot))
-		   (entity)
-		   (list 'aref entity
-			 ,(luna-class-slot-index entity-class
-						 (intern (symbol-name slot)))
-			 ))
-		 (defmacro ,(intern (format "%s-set-%s-internal"
-					    class-name slot))
-		   (entity value)
-		   (list 'aset entity
-			 ,(luna-class-slot-index
-			   entity-class (intern (symbol-name slot)))
-			 value))
-		 ))
-	     )))
+     (function
+      (lambda (slot)
+	(if (luna-class-slot-index entity-class slot)
+	    (catch 'derived
+	      (setq parents (luna-class-parents entity-class))
+	      (while parents
+		(setq parent-class (luna-find-class (car parents)))
+		(if (luna-class-slot-index parent-class slot)
+		    (throw 'derived nil))
+		(setq parents (cdr parents))
+		)
+	      (eval
+	       (` (progn
+		    (defmacro (, (intern (format "%s-%s-internal"
+						 class-name slot)))
+		      (entity)
+		      (list 'aref entity
+			    (, (luna-class-slot-index entity-class
+						      (intern (symbol-name slot))))
+			    ))
+		    (defmacro (, (intern (format "%s-set-%s-internal"
+						 class-name slot)))
+		      (entity value)
+		      (list 'aset entity
+			    (, (luna-class-slot-index
+				entity-class (intern (symbol-name slot))))
+			    value))
+		    )))
+	      ))))
      (luna-class-obarray entity-class))))
 
 (luna-define-class-function 'standard-object)