From: tomo <tomo>
Date: Thu, 14 Dec 2000 04:57:26 +0000 (+0000)
Subject: Apply Handa-san's patch <200012130452.NAA13293@etlken.etl.go.jp>.
X-Git-Tag: semi21-1_14_0-pre4~2
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9d43a05430beb5f6f1ad70b6bcb4c6d2f698a154;p=elisp%2Flemi.git

Apply Handa-san's patch <200012130452.NAA13293@etlken.etl.go.jp>.
---

diff --git a/mime/luna.el b/mime/luna.el
index 7a8cb53..d9a4fa3 100644
--- a/mime/luna.el
+++ b/mime/luna.el
@@ -31,30 +31,42 @@
 ;;;
 
 (defmacro luna-find-class (name)
-  "Return the luna-class of the given NAME."
+  "Return a luna-class that has NAME."
   `(get ,name 'luna-class))
 
+;; Give NAME (symbol) the luna-class CLASS.
 (defmacro luna-set-class (name class)
   `(put ,name 'luna-class ,class))
 
+;; Return the obarray of luna-class CLASS.
 (defmacro luna-class-obarray (class)
   `(aref ,class 1))
 
+;; Return the parents of luna-class CLASS.
 (defmacro luna-class-parents (class)
   `(aref ,class 2))
 
+;; Return the number of slots of luna-class CLASS.
 (defmacro luna-class-number-of-slots (class)
   `(aref ,class 3))
 
-(defmacro luna-define-class (type &optional parents slots)
-  "Define TYPE as a luna-class.
-If PARENTS is specified, TYPE inherits PARENTS.
-Each parent must be name of luna-class (symbol).
-If SLOTS is specified, TYPE will be defined to have them."
-  `(luna-define-class-function ',type ',(append parents '(standard-object))
+(defmacro luna-define-class (class &optional parents slots)
+  "Define CLASS as a luna-class.
+CLASS always inherits the luna-class `standard-object'.
+
+The optional 1st arg PARENTS is a list luna-class names.  These
+luna-classes are also inheritted by CLASS.
+
+The optional 2nd arg SLOTS is a list of slots CLASS will have."
+  `(luna-define-class-function ',class ',(append parents '(standard-object))
 			       ',slots))
 
-(defun luna-define-class-function (type &optional parents slots)
+
+;; Define CLASS as a luna-class.  PARENTS, if non-nil, is a list of
+;; luna-class names inherited by CLASS.  SLOTS, if non-nil, is a list
+;; of slots belonging to CLASS.
+
+(defun luna-define-class-function (class &optional parents slots)
   (let ((oa (make-vector 31 0))
 	(rest parents)
 	parent name
@@ -76,7 +88,11 @@ If SLOTS is specified, TYPE will be defined to have them."
       (unless (intern-soft name oa)
 	(put (intern name oa) 'luna-slot-index i)
 	(setq i (1+ i))))
-    (luna-set-class type (vector 'class oa parents i))))
+    (luna-set-class class (vector 'class oa parents i))))
+
+
+;; Return a member of CLASS that has name MEMBER-NAME.
+;;;%%% member って何？ slots? subclass?
 
 (defun luna-class-find-member (class member-name)
   (or (stringp member-name)
@@ -91,33 +107,53 @@ If SLOTS is specified, TYPE will be defined to have them."
 				member-name)))))
 	ret)))
 
+
+;; Return a member of CLASS that has name MEMBER-NAME.  If CLASS
+;; doesnt' have such a member, make it for CLASS.
+
 (defsubst luna-class-find-or-make-member (class member-name)
   (or (stringp member-name)
       (setq member-name (symbol-name member-name)))
   (intern member-name (luna-class-obarray class)))
 
+
+;; Return the index number of SLOT-NAME in CLASS.
+
 (defmacro luna-class-slot-index (class slot-name)
   `(get (luna-class-find-member ,class ,slot-name) 'luna-slot-index))
 
+
+;;;%%% docstring を大幅に書き直したので正しいかチェックして！
+;;;%%% 特に VAR の意味が分らない。
+
 (defmacro luna-define-method (name &rest definition)
-  "Define NAME as a method function of a class.
+  "Define NAME as a method of a luna class.
 
 Usage of this macro follows:
 
-  (luna-define-method NAME [METHOD-QUALIFIER] ARGLIST [DOCSTRING] BODY...) 
+  (luna-define-method NAME [METHOD-QUALIFIER] ARGLIST [DOCSTRING] BODY...)
+
+The optional 1st argument METHOD-QUALIFIER specifies when and how the
+method is called.
 
-NAME is the name of method.
+If it is :before, call the method before calling the parents' methods.
 
-Optional argument METHOD-QUALIFIER must be :before, :after or :around.
-If it is :before / :after, the method is called before / after a
-method of parent class is finished.  ARGLIST is like an argument list
-of lambda, but (car ARGLIST) must be specialized parameter.  (car (car
-ARGLIST)) is name of variable and \(nth 1 (car ARGLIST)) is name of
-class.
+If it is :after, call the method after calling the parents' methods.
 
-Optional argument DOCSTRING is the documentation of method.
+If it is :around, call the method only.  The parents' methods can be
+executed by calling the function `luna-call-next-method' in BODY.
 
-BODY is the body of method."
+Otherwize, call the method only, and the parents' methods are never
+executed.  In this case, METHOD-QUALIFIER is treated as ARGLIST.
+
+ARGLIST has the form ((VAR CLASS) METHOD-ARG-LIST), where VAR is a
+variable name, CLASS is a class name, METHOD-ARG-LIST is an argument
+list of the method, and its format is like an argument list of lambda.
+
+The optional 4th argument DOCSTRING is the documentation of the
+method.  If it is not string, it is treated as BODY.
+
+The optional 5th BODY is the body of the method."
   (let ((method-qualifier (pop definition))
 	args specializer class self)
     (if (memq method-qualifier '(:before :after :around))
@@ -149,6 +185,10 @@ BODY is the body of method."
 	    &optional ["&rest" arg])
 	   def-body))
 
+
+;; Return a list of method functions named SERVICE registered in the
+;; parents of CLASS.
+
 (defun luna-class-find-parents-functions (class service)
   (let ((parents (luna-class-parents class))
 	ret)
@@ -159,6 +199,9 @@ BODY is the body of method."
 			    service)))))
     ret))
 
+;; Return a list of method functions named SERVICE registered in CLASS
+;; and the parents..
+
 (defun luna-class-find-functions (class service)
   (let ((sym (luna-class-find-member class service)))
     (if (fboundp sym)
@@ -207,8 +250,12 @@ BODY is the body of method."
   `(luna-class-find-functions (luna-find-class (luna-class-name ,entity))
 			      ,service))
 
+;;;%%% ENTITY と MESSAGE の説明は合ってる？
+
 (defsubst luna-send (entity message &rest luna-current-method-arguments)
   "Send MESSAGE to ENTITY, and return the result.
+ENTITY is an instance of a luna class, and MESSAGE is a method name of
+the luna class.
 LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE."
   (let ((luna-next-methods (luna-find-functions entity message))
 	luna-current-method
@@ -230,7 +277,9 @@ LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE."
   (defvar luna-current-method-arguments nil))
 
 (defun luna-call-next-method ()
-  "Call the next method in a method with :around qualifier."
+  "Call the next method in the current method function.
+A method function that has :around qualifier should call this function
+to execute the parents' methods."
   (let (luna-current-method
 	luna-previous-return-value)
     (while (and luna-next-methods
@@ -245,13 +294,14 @@ LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE."
 		    t))))
     luna-previous-return-value))
 
-(defun luna-make-entity (type &rest init-args)
-  "Make instance of luna-class TYPE and return it.
-If INIT-ARGS is specified, it is used as initial values of the slots.
-It must be plist and each slot name must have prefix `:'."
-  (let* ((c (get type 'luna-class))
+(defun luna-make-entity (class &rest init-args)
+  "Make an entity (instance) of luna-class CLASS and return it.
+INIT-ARGS is a plist of the form (:SLOT1 VAL1 :SLOT2 VAL2 ...),
+where SLOTs are slots of CLASS and the VALs are initial values of
+the corresponding SLOTs."
+  (let* ((c (get class 'luna-class))
 	 (v (make-vector (luna-class-number-of-slots c) nil)))
-    (luna-set-class-name v type)
+    (luna-set-class-name v class)
     (luna-set-obarray v (make-vector 7 0))
     (apply #'luna-send v 'initialize-instance v init-args)))
 
@@ -259,6 +309,8 @@ It must be plist and each slot name must have prefix `:'."
 ;;; @ interface (generic function)
 ;;;
 
+;;;%%% どうコメントを書いたらよいか分らない。
+
 (defun luna-apply-generic (entity message &rest luna-current-method-arguments)
   (let* ((class (luna-class-name entity))
 	 (cache (get message 'luna-method-cache))
@@ -272,6 +324,10 @@ It must be plist and each slot name must have prefix `:'."
 	   luna-next-methods))
     (luna-call-next-method)))
 
+
+;; Convert ARGLIST (argument list spec for a method function) to the
+;; actual list of arguments.
+
 (defsubst luna-arglist-to-arguments (arglist)
   (let (dest)
     (while arglist
@@ -281,9 +337,14 @@ It must be plist and each slot name must have prefix `:'."
       (setq arglist (cdr arglist)))
     (nreverse dest)))
 
+
+;;;%%% generic-function って何？それで define するって具体的にどういう
+;;;%%% こと？
+
 (defmacro luna-define-generic (name args &optional doc)
   "Define generic-function NAME.
-ARGS is argument of and DOC is DOC-string."
+ARGS is the argument list for NAME.
+The optional 3rd arg DOC is the documentation string for NAME."
   (if doc
       `(progn
 	 (defun ,(intern (symbol-name name)) ,args
@@ -303,6 +364,8 @@ ARGS is argument of and DOC is DOC-string."
 ;;; @ accessor
 ;;;
 
+;;;%%% internal accessor って何？どう使うの？
+
 (defun luna-define-internal-accessors (class-name)
   "Define internal accessors for an entity of CLASS-NAME."
   (let ((entity-class (luna-find-class class-name))
@@ -338,10 +401,13 @@ ARGS is argument of and DOC is DOC-string."
 ;;; @ standard object
 ;;;
 
+;; Define super class of all luna classes.
 (luna-define-class-function 'standard-object)
 
+;;;%%% DOCSTRING 正しい？
 (luna-define-method initialize-instance ((entity standard-object)
 					 &rest init-args)
+  "Initialize slots of ENTITY whose luna class is `standard-object'."
   (let* ((c (luna-find-class (luna-class-name entity)))
 	 (oa (luna-class-obarray c))
 	 s i)
diff --git a/mime/mmbabyl.el b/mime/mmbabyl.el
index 978a6f9..559a9e5 100644
--- a/mime/mmbabyl.el
+++ b/mime/mmbabyl.el
@@ -5,7 +5,7 @@
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: Babyl, RMAIL, MIME, multimedia, mail
 
-;; This file is part of FLIM (Faithful Library about Internet Message).
+;; This file is part of GNU Emacs.
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -31,11 +31,12 @@
 		     (visible-header-start
 		      visible-header-end))
 
-  (luna-define-internal-accessors 'mime-babyl-entity)
-  )
+  (luna-define-internal-accessors 'mime-babyl-entity))
 
 (luna-define-method initialize-instance
   :after ((entity mime-babyl-entity) &rest init-args)
+  "Initialize slots of ENTITY.
+ENTITY is an instance of `mime-babyl-entity'."
   (or (mime-buffer-entity-buffer-internal entity)
       (mime-buffer-entity-set-buffer-internal
        entity (get-buffer (mime-entity-location-internal entity))))
@@ -95,6 +96,10 @@
 ;;;
 
 (luna-define-method mime-insert-entity ((entity mime-babyl-entity))
+   "Insert ENTITY into the current buffer.
+ENTITY is an instance of `mime-babyl-entity'.
+The header part and the body part of ENTITY are separated by a blank
+line."
   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
 			   (mime-buffer-entity-header-start-internal entity)
 			   (mime-buffer-entity-header-end-internal entity))
@@ -106,6 +111,8 @@
 
 (luna-define-method mime-write-entity ((entity mime-babyl-entity)
 				       filename)
+  "Write ENTITY into FILENAME.
+ENTITY is an instance of `mime-babyl-entity'."
   (with-temp-buffer
     (mime-insert-entity entity)
     (write-region-as-raw-text-CRLF (point-min) (point-max) filename)))
@@ -126,9 +133,15 @@
 ;;; @ header field
 ;;;
 
+;;;%%% docstring を完成させて。
+
 (luna-define-method mime-insert-header ((entity mime-babyl-entity)
 					&optional invisible-fields
 					visible-fields)
+  "Insert the header of ENTITY in the current buffer.
+ENTITY is an instance of `mime-babyl-entity'.
+The optional 1st arguemnt INVISIBLE-FIELDS is a list of ....
+The optional 2nd arguemnt VISIBLE-FIELDS is a list of ...."
   (mime-insert-header-from-buffer
    (mime-buffer-entity-buffer-internal entity)
    (mime-babyl-entity-visible-header-start-internal entity)
@@ -140,7 +153,11 @@
 ;;; @ children
 ;;;
 
+;;;%%% docstring 合ってる？
+
 (luna-define-method mime-entity-children ((entity mime-babyl-entity))
+  "Return a list of ENTITY's children.
+ENTITY is an instance of `mime-babyl-entity'."
   (let* ((content-type (mime-entity-content-type entity))
 	 (primary-type (mime-content-type-primary-type content-type))
 	 sub-type)