diff options
Diffstat (limited to 'lisp/emacs-lisp/eieio.el')
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 56 |
1 files changed, 30 insertions, 26 deletions
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 3b633e4fa36..8351d97b13d 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -110,7 +110,7 @@ Options in CLOS not supported in EIEIO: Due to the way class options are set up, you can add any tags you wish, and reference them using the function `class-option'." - (declare (doc-string 4)) + (declare (doc-string 4) (indent defun)) (cl-check-type superclasses list) (cond ((and (stringp (car options-and-doc)) @@ -136,6 +136,7 @@ and reference them using the function `class-option'." (accessors ())) ;; Collect the accessors we need to define. + (setq slots (mapcar (lambda (x) (if (consp x) x (list x))) slots)) (pcase-dolist (`(,sname . ,soptions) slots) (let* ((acces (plist-get soptions :accessor)) (initarg (plist-get soptions :initarg)) @@ -181,9 +182,11 @@ and reference them using the function `class-option'." ;; Is there an initarg, but allocation of class? (when (and initarg (eq alloc :class)) - (push (format "Meaningless :initarg for class allocated slot '%S'" - sname) - warnings)) + (push + (cons sname + (format "Meaningless :initarg for class allocated slot '%S'" + sname)) + warnings)) (let ((init (plist-get soptions :initform))) (unless (or (macroexp-const-p init) @@ -194,8 +197,9 @@ and reference them using the function `class-option'." ;; heuristic says and if it disagrees with normal evaluation ;; then tweak the initform to make it fit and emit ;; a warning accordingly. - (push (format "Ambiguous initform needs quoting: %S" init) - warnings))) + (push + (cons init (format "Ambiguous initform needs quoting: %S" init)) + warnings))) ;; Anyone can have an accessor function. This creates a function ;; of the specified name, and also performs a `defsetf' if applicable @@ -214,10 +218,11 @@ and reference them using the function `class-option'." (when (and eieio-backward-compatibility (eq alloc :class)) ;; FIXME: How could I declare this *method* as obsolete. (push `(cl-defmethod ,acces ((this (subclass ,name))) - ,(format - "Retrieve the class slot `%S' from a class `%S'. -This method is obsolete." - sname name) + ,(concat + (internal--format-docstring-line + "Retrieve the class slot `%S' from a class `%S'." + sname name) + "\nThis method is obsolete.") (if (slot-boundp this ',sname) (eieio-oref-default this ',sname))) accessors))) @@ -226,23 +231,26 @@ This method is obsolete." ;; name whose purpose is to set the value of the slot. (if writer (push `(cl-defmethod ,writer ((this ,name) value) - ,(format "Set the slot `%S' of an object of class `%S'." - sname name) + ,(internal--format-docstring-line + "Set the slot `%S' of an object of class `%S'." + sname name) (setf (slot-value this ',sname) value)) accessors)) ;; If a reader is defined, then create a generic method ;; of that name whose purpose is to access this slot value. (if reader (push `(cl-defmethod ,reader ((this ,name)) - ,(format "Access the slot `%S' from object of class `%S'." - sname name) + ,(internal--format-docstring-line + "Access the slot `%S' from object of class `%S'." + sname name) (slot-value this ',sname)) accessors)) )) `(progn ,@(mapcar (lambda (w) - (macroexp-warn-and-return w `(progn ',w) nil 'compile-only)) + (macroexp-warn-and-return + (cdr w) `(progn ',(cdr w)) nil 'compile-only (car w))) warnings) ;; This test must be created right away so we can have self- ;; referencing classes. ei, a class whose slot can contain only @@ -256,7 +264,7 @@ This method is obsolete." (let ((f (intern (format "%s-child-p" name)))) `((defalias ',f #',testsym2) (make-obsolete - ',f ,(format "use (cl-typep ... \\='%s) instead" name) + ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1")))) ;; When using typep, (typep OBJ 'myclass) returns t for objects which @@ -267,7 +275,8 @@ This method is obsolete." ;; test, so we can let typep have the CLOS documented behavior ;; while keeping our above predicate clean. - (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2) + (eval-and-compile + (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2)) (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc) @@ -297,7 +306,8 @@ This method is obsolete." ;; Keep the name arg, for backward compatibility, ;; but hide it so we don't trigger indefinitely. `(,(car whole) (identity ,(car slots)) - ,@(cdr slots))))))) + ,@(cdr slots)) + nil nil (car slots)))))) (apply #'make-instance ',name slots)))))) @@ -359,9 +369,7 @@ variable name of the same name as the slot." (defun eieio-pcase-slot-index-from-index-table (index-table slot) "Find the index to pass to `aref' to access SLOT." - (let ((index (gethash slot index-table))) - (if index (+ (eval-when-compile eieio--object-num-slots) - index)))) + (gethash slot index-table)) (pcase-defmacro eieio (&rest fields) "Pcase patterns that match EIEIO object EXPVAL. @@ -685,6 +693,7 @@ This class is not stored in the `parent' slot of a class vector." (define-obsolete-function-alias 'standard-class #'eieio-default-superclass "26.1") +;;;###autoload (cl-defgeneric make-instance (class &rest initargs) "Make a new instance of CLASS based on INITARGS. For example: @@ -994,11 +1003,6 @@ of `eq'." (error "EIEIO: `change-class' is unimplemented")) (define-obsolete-function-alias 'change-class #'eieio-change-class "26.1") -;; Hook ourselves into help system for describing classes and methods. -;; FIXME: This is not actually needed any more since we can click on the -;; hyperlink from the constructor's docstring to see the type definition. -(add-hook 'help-fns-describe-function-functions #'eieio-help-constructor) - (provide 'eieio) ;;; eieio.el ends here |