lisp/emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var.
* lisp/cedet/ede/speedbar.el (ede-speedbar-compile-line)
(ede-speedbar-get-top-project-for-line):
* lisp/cedet/ede.el (ede-buffer-belongs-to-target-p)
(ede-buffer-belongs-to-project-p, ede-build-forms-menu)
(ede-add-project-to-global-list):
* lisp/cedet/semantic/db-typecache.el (semanticdb-get-typecache):
* lisp/cedet/semantic/db-file.el (semanticdb-load-database):
* lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym->tag):
* lisp/cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper):
* lisp/cedet/ede/project-am.el (project-am-preferred-target-type):
* lisp/cedet/ede/proj.el (ede-proj-load):
* lisp/cedet/ede/custom.el (ede-customize-current-target, ede-customize-target):
* lisp/cedet/semantic/ede-grammar.el ("semantic grammar"):
* lisp/cedet/semantic/scope.el (semantic-scope-reset-cache)
(semantic-calculate-scope):
* lisp/cedet/srecode/map.el (srecode-map-update-map):
* lisp/cedet/srecode/insert.el (srecode-insert-show-error-report)
(srecode-insert-method, srecode-insert-include-lookup)
(srecode-insert-method):
* lisp/cedet/srecode/fields.el (srecode-active-template-region):
* lisp/cedet/srecode/compile.el (srecode-flush-active-templates)
(srecode-compile-inserter): Don't use <class> as a variable.
Use `oref-default' for class slots.
* lisp/cedet/semantic/grammar.el (semantic-grammar-eldoc-last-data): New var.
(semantic-grammar-eldoc-get-macro-docstring): Use it instead of
eldoc-last-data.
* lisp/cedet/semantic/fw.el (semantic-exit-on-input): Use `declare'.
(semantic-throw-on-input): Use `with-current-buffer'.
* lisp/cedet/semantic/db.el (semanticdb-abstract-table-list): Define if not
pre-defined.
* lisp/cedet/semantic/db-find.el (semanticdb-find-tags-collector):
Use save-current-buffer.
(semanticdb-find-tags-collector): Don't use <class> as a variable.
* lisp/cedet/semantic/complete.el (semantic-complete-active-default)
(semantic-complete-current-matched-tag): Declare.
(semantic-complete-inline-custom-type): Don't use <class> as a variable.
* lisp/cedet/semantic/bovine/make.el (semantic-analyze-possible-completions):
Use with-current-buffer.
* lisp/cedet/semantic.el (semantic-parser-warnings): Declare.
* lisp/cedet/ede/base.el (ede-target-list): Define if not pre-defined.
(ede-with-projectfile): Prefer find-file-noselect over
save-window-excursion.
* lisp/emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie):
Don't use <class> as a variable.
* lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
Improve error messages.
(eieio-persistent-slot-type-is-class-p): Handle `list-of' types, as
well as user-defined types. Emit errors for legacy types like
<class>-child and <class>-list, if not eieio-backward-compatibility.
* lisp/emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var.
(eieio-defclass-autoload): Obey it.
(eieio--class-object): Improve error behavior.
(eieio-class-children-fast, same-class-fast-p): Remove. Inline at
every use site.
(eieio--defgeneric-form-primary-only): Rename from
eieio-defgeneric-form-primary-only; update all callers.
(eieio--defgeneric-form-primary-only-one): Rename from
eieio-defgeneric-form-primary-only-one; update all callers.
(eieio-defgeneric-reset-generic-form)
(eieio-defgeneric-reset-generic-form-primary-only)
(eieio-defgeneric-reset-generic-form-primary-only-one): Remove.
(eieio--method-optimize-primary): New function to replace them.
(eieio--defmethod, eieio-defmethod): Use it.
(eieio--perform-slot-validation): Rename from
eieio-perform-slot-validation; update all callers.
(eieio--validate-slot-value): Rename from eieio-validate-slot-value.
Change `class' to be a class object. Update all callers.
(eieio--validate-class-slot-value): Rename from
eieio-validate-class-slot-value. Change `class' to be a class object.
Update all callers.
(eieio-oset-default): Accept class object as well.
(eieio--generic-call-primary-only): Rename from
eieio-generic-call-primary-only. Update all callers.
* lisp/emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove.
(eieio-read-generic): Use `generic-p' instead.
* lisp/emacs-lisp/eieio.el (same-class-p): Accept class object as well.
(call-next-method): Simplify.
(clone): Obey eieio-backward-compatibility.
* lisp/gnus/registry.el: Don't use <class> as a variable.
* test/automated/eieio-test-methodinvoke.el
(eieio-test-method-order-list-4):
Don't use <class> as a variable.
* test/automated/eieio-test-persist.el (persistent-with-objs-list-slot):
Don't use <class>-list type.
* test/automated/eieio-tests.el: Use cl-lib. Don't use <class> as a variable.
Don't use <class>-list types and <class>-list-p predicates.
This commit is contained in:
Stefan Monnier
parent
cb4db86319
commit
1599688e95
39 changed files with 414 additions and 290 deletions
|
|
@ -422,7 +422,7 @@ or is created with the bounds of SEQ."
|
|||
(if (stringp (car (oref seq data)))
|
||||
(let ((labels (oref seq data)))
|
||||
(if (not axis)
|
||||
(setq axis (make-instance chart-axis-names
|
||||
(setq axis (make-instance 'chart-axis-names
|
||||
:name (oref seq name)
|
||||
:items labels
|
||||
:chart c))
|
||||
|
|
@ -430,7 +430,7 @@ or is created with the bounds of SEQ."
|
|||
(let ((range (cons 0 1))
|
||||
(l (oref seq data)))
|
||||
(if (not axis)
|
||||
(setq axis (make-instance chart-axis-range
|
||||
(setq axis (make-instance 'chart-axis-range
|
||||
:name (oref seq name)
|
||||
:chart c)))
|
||||
(while l
|
||||
|
|
@ -577,19 +577,19 @@ labeled NUMTITLE.
|
|||
Optional arguments:
|
||||
Set the chart's max element display to MAX, and sort lists with
|
||||
SORT-PRED if desired."
|
||||
(let ((nc (make-instance chart-bar
|
||||
(let ((nc (make-instance 'chart-bar
|
||||
:title title
|
||||
:key-label "8-m" ; This is a text key pic
|
||||
:direction dir
|
||||
))
|
||||
(iv (eq dir 'vertical)))
|
||||
(chart-add-sequence nc
|
||||
(make-instance chart-sequece
|
||||
(make-instance 'chart-sequece
|
||||
:data namelst
|
||||
:name nametitle)
|
||||
(if iv 'x-axis 'y-axis))
|
||||
(chart-add-sequence nc
|
||||
(make-instance chart-sequece
|
||||
(make-instance 'chart-sequece
|
||||
:data numlst
|
||||
:name numtitle)
|
||||
(if iv 'y-axis 'x-axis))
|
||||
|
|
|
|||
|
|
@ -333,8 +333,8 @@ Second, any text properties will be stripped from strings."
|
|||
(unless (and
|
||||
;; Do we have a type?
|
||||
(consp classtype) (class-p (car classtype)))
|
||||
(error "In save file, list of object constructors found, but no :type specified for slot %S"
|
||||
slot))
|
||||
(error "In save file, list of object constructors found, but no :type specified for slot %S of type %S"
|
||||
slot classtype))
|
||||
|
||||
;; We have a predicate, but it doesn't satisfy the predicate?
|
||||
(dolist (PV (cdr proposed-value))
|
||||
|
|
@ -367,10 +367,24 @@ If no class is referenced there, then return nil."
|
|||
(cond ((class-p type)
|
||||
;; If the type is a class, then return it.
|
||||
type)
|
||||
((and (eq 'list-of (car-safe type)) (class-p (cadr type)))
|
||||
;; If it is the type of a list of a class, then return that class and
|
||||
;; the type.
|
||||
(cons (cadr type) type))
|
||||
|
||||
((and (symbolp type) (get type 'cl-deftype-handler))
|
||||
;; Macro-expand the type according to cl-deftype definitions.
|
||||
(eieio-persistent-slot-type-is-class-p
|
||||
(funcall (get type 'cl-deftype-handler))))
|
||||
|
||||
;; FIXME: foo-child should not be a valid type!
|
||||
((and (symbolp type) (string-match "-child\\'" (symbol-name type))
|
||||
(class-p (intern-soft (substring (symbol-name type) 0
|
||||
(match-beginning 0)))))
|
||||
(unless eieio-backward-compatibility
|
||||
(error "Use of bogus %S type instead of %S"
|
||||
type (intern-soft (substring (symbol-name type) 0
|
||||
(match-beginning 0)))))
|
||||
;; If it is the predicate ending with -child, then return
|
||||
;; that class. Unfortunately, in EIEIO, typep of just the
|
||||
;; class is the same as if we used -child, so no further work needed.
|
||||
|
|
@ -380,13 +394,17 @@ If no class is referenced there, then return nil."
|
|||
((and (symbolp type) (string-match "-list\\'" (symbol-name type))
|
||||
(class-p (intern-soft (substring (symbol-name type) 0
|
||||
(match-beginning 0)))))
|
||||
(unless eieio-backward-compatibility
|
||||
(error "Use of bogus %S type instead of (list-of %S)"
|
||||
type (intern-soft (substring (symbol-name type) 0
|
||||
(match-beginning 0)))))
|
||||
;; If it is the predicate ending with -list, then return
|
||||
;; that class and the predicate to use.
|
||||
(cons (intern-soft (substring (symbol-name type) 0
|
||||
(match-beginning 0)))
|
||||
type))
|
||||
|
||||
((and (consp type) (eq (car type) 'or))
|
||||
((eq (car-safe type) 'or)
|
||||
;; If type is a list, and is an or, it is possibly something
|
||||
;; like (or null myclass), so check for that.
|
||||
(let ((ans nil))
|
||||
|
|
|
|||
|
|
@ -77,6 +77,13 @@ default setting for optimization purposes.")
|
|||
(defvar eieio-initializing-object nil
|
||||
"Set to non-nil while initializing an object.")
|
||||
|
||||
(defvar eieio-backward-compatibility t
|
||||
"If nil, drop support for some behaviors of older versions of EIEIO.
|
||||
Currently under control of this var:
|
||||
- Define every class as a var whose value is the class symbol.
|
||||
- Define <class>-child-p and <class>-list-p predicates.
|
||||
- Allow object names in constructors.")
|
||||
|
||||
(defconst eieio-unbound
|
||||
(if (and (boundp 'eieio-unbound) (symbolp eieio-unbound))
|
||||
eieio-unbound
|
||||
|
|
@ -217,7 +224,10 @@ Stored outright without modifications or stripping.")))
|
|||
|
||||
(defsubst eieio--class-object (class)
|
||||
"Return the class object."
|
||||
(if (symbolp class) (eieio--class-v class) class))
|
||||
(if (symbolp class)
|
||||
;; Keep the symbol if class-v is nil, for better error messages.
|
||||
(or (eieio--class-v class) class)
|
||||
class))
|
||||
|
||||
(defsubst eieio--class-p (class)
|
||||
"Return non-nil if CLASS is a valid class object."
|
||||
|
|
@ -251,16 +261,6 @@ CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
|
|||
(format "#<class %s>" (symbol-name class)))
|
||||
(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
|
||||
|
||||
(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check."
|
||||
;; FIXME: Remove. And change `children' to contain class objects rather than
|
||||
;; class names.
|
||||
`(eieio--class-children (eieio--class-v ,class)))
|
||||
|
||||
(defsubst same-class-fast-p (obj class-name)
|
||||
"Return t if OBJ is of class-type CLASS-NAME with no error checking."
|
||||
;; (eq (eieio--object-class-name obj) class)
|
||||
(eq (eieio--object-class-object obj) (eieio--class-object class-name)))
|
||||
|
||||
(defmacro class-constructor (class)
|
||||
"Return the symbol representing the constructor of CLASS."
|
||||
(declare (debug t))
|
||||
|
|
@ -388,7 +388,8 @@ It creates an autoload function for CNAME's constructor."
|
|||
(push (eieio--class-v SC) (eieio--class-parent newc)))
|
||||
|
||||
;; turn this into a usable self-pointing symbol
|
||||
(set cname cname)
|
||||
(when eieio-backward-compatibility
|
||||
(set cname cname))
|
||||
|
||||
;; Store the new class vector definition into the symbol. We need to
|
||||
;; do this first so that we can call defmethod for the accessor.
|
||||
|
|
@ -499,7 +500,8 @@ See `defclass' for more information."
|
|||
(setf (eieio--class-parent newc) (list eieio-default-superclass))))
|
||||
|
||||
;; turn this into a usable self-pointing symbol; FIXME: Why?
|
||||
(set cname cname)
|
||||
(when eieio-backward-compatibility
|
||||
(set cname cname))
|
||||
|
||||
;; These two tests must be created right away so we can have self-
|
||||
;; referencing classes. ei, a class whose slot can contain only
|
||||
|
|
@ -520,7 +522,9 @@ See `defclass' for more information."
|
|||
))
|
||||
|
||||
;; Create a handy child test too
|
||||
(let ((csym (intern (concat (symbol-name cname) "-child-p"))))
|
||||
(let ((csym (if eieio-backward-compatibility
|
||||
(intern (concat (symbol-name cname) "-child-p"))
|
||||
(make-symbol (concat (symbol-name cname) "-child-p")))))
|
||||
(fset csym
|
||||
`(lambda (obj)
|
||||
,(format
|
||||
|
|
@ -540,21 +544,22 @@ See `defclass' for more information."
|
|||
(put cname 'cl-deftype-satisfies csym))
|
||||
|
||||
;; Create a handy list of the class test too
|
||||
(let ((csym (intern (concat (symbol-name cname) "-list-p"))))
|
||||
(fset csym
|
||||
`(lambda (obj)
|
||||
,(format
|
||||
"Test OBJ to see if it a list of objects which are a child of type %s"
|
||||
cname)
|
||||
(when (listp obj)
|
||||
(let ((ans t)) ;; nil is valid
|
||||
;; Loop over all the elements of the input list, test
|
||||
;; each to make sure it is a child of the desired object class.
|
||||
(while (and obj ans)
|
||||
(setq ans (and (eieio-object-p (car obj))
|
||||
(object-of-class-p (car obj) ,cname)))
|
||||
(setq obj (cdr obj)))
|
||||
ans)))))
|
||||
(when eieio-backward-compatibility
|
||||
(let ((csym (intern (concat (symbol-name cname) "-list-p"))))
|
||||
(fset csym
|
||||
`(lambda (obj)
|
||||
,(format
|
||||
"Test OBJ to see if it a list of objects which are a child of type %s"
|
||||
cname)
|
||||
(when (listp obj)
|
||||
(let ((ans t)) ;; nil is valid
|
||||
;; Loop over all the elements of the input list, test
|
||||
;; each to make sure it is a child of the desired object class.
|
||||
(while (and obj ans)
|
||||
(setq ans (and (eieio-object-p (car obj))
|
||||
(object-of-class-p (car obj) ,cname)))
|
||||
(setq obj (cdr obj)))
|
||||
ans))))))
|
||||
|
||||
;; Before adding new slots, let's add all the methods and classes
|
||||
;; in from the parent class.
|
||||
|
|
@ -767,7 +772,8 @@ See `defclass' for more information."
|
|||
(if (and slots
|
||||
(let ((x (car slots)))
|
||||
(or (stringp x) (null x))))
|
||||
(message "Obsolete name %S passed to %S constructor"
|
||||
(funcall (if eieio-backward-compatibility #'ignore #'message)
|
||||
"Obsolete name %S passed to %S constructor"
|
||||
(pop slots) ',cname))
|
||||
(apply #'eieio-constructor ',cname slots)))
|
||||
)
|
||||
|
|
@ -833,7 +839,7 @@ If SKIPNIL is non-nil, then if VALUE is nil return t instead."
|
|||
(if (not (or (eieio-eval-default-p value) ;FIXME: Why?
|
||||
eieio-skip-typecheck
|
||||
(and skipnil (null value))
|
||||
(eieio-perform-slot-validation spec value)))
|
||||
(eieio--perform-slot-validation spec value)))
|
||||
(signal 'invalid-slot-type (list slot spec value))))
|
||||
|
||||
(defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc
|
||||
|
|
@ -1155,24 +1161,12 @@ DOC-STRING is the documentation attached to METHOD."
|
|||
(lambda (&rest local-args)
|
||||
(eieio-generic-call method local-args)))
|
||||
|
||||
(defsubst eieio-defgeneric-reset-generic-form (method)
|
||||
"Setup METHOD to call the generic form."
|
||||
(let ((doc-string (documentation method 'raw)))
|
||||
(put method 'function-documentation doc-string)
|
||||
(fset method (eieio-defgeneric-form method))))
|
||||
|
||||
(defun eieio-defgeneric-form-primary-only (method)
|
||||
(defun eieio--defgeneric-form-primary-only (method)
|
||||
"The lambda form that would be used as the function defined on METHOD.
|
||||
All methods should call the same EIEIO function for dispatch.
|
||||
DOC-STRING is the documentation attached to METHOD."
|
||||
(lambda (&rest local-args)
|
||||
(eieio-generic-call-primary-only method local-args)))
|
||||
|
||||
(defsubst eieio-defgeneric-reset-generic-form-primary-only (method)
|
||||
"Setup METHOD to call the generic form."
|
||||
(let ((doc-string (documentation method 'raw)))
|
||||
(put method 'function-documentation doc-string)
|
||||
(fset method (eieio-defgeneric-form-primary-only method))))
|
||||
(eieio--generic-call-primary-only method local-args)))
|
||||
|
||||
(declare-function no-applicable-method "eieio" (object method &rest args))
|
||||
|
||||
|
|
@ -1186,7 +1180,7 @@ Keys are a number representing :before, :primary, and :after methods.")
|
|||
During executions, the list is first generated, then as each next method
|
||||
is called, the next method is popped off the stack.")
|
||||
|
||||
(defun eieio-defgeneric-form-primary-only-one (method class impl)
|
||||
(defun eieio--defgeneric-form-primary-only-one (method class impl)
|
||||
"The lambda form that would be used as the function defined on METHOD.
|
||||
All methods should call the same EIEIO function for dispatch.
|
||||
CLASS is the class symbol needed for private method access.
|
||||
|
|
@ -1219,16 +1213,6 @@ IMPL is the symbol holding the method implementation."
|
|||
(eieio--with-scoped-class (eieio--class-v class)
|
||||
(apply impl local-args)))))))
|
||||
|
||||
(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
|
||||
"Setup METHOD to call the generic form."
|
||||
(let* ((doc-string (documentation method 'raw))
|
||||
(M (get method 'eieio-method-tree))
|
||||
(entry (car (aref M eieio--method-primary)))
|
||||
)
|
||||
(put method 'function-documentation doc-string)
|
||||
(fset method (eieio-defgeneric-form-primary-only-one
|
||||
method (car entry) (cdr entry)))))
|
||||
|
||||
(defun eieio-unbind-method-implementations (method)
|
||||
"Make the generic method METHOD have no implementations.
|
||||
It will leave the original generic function in place,
|
||||
|
|
@ -1236,6 +1220,27 @@ but remove reference to all implementations of METHOD."
|
|||
(put method 'eieio-method-tree nil)
|
||||
(put method 'eieio-method-hashtable nil))
|
||||
|
||||
(defun eieio--method-optimize-primary (method)
|
||||
(when eieio-optimize-primary-methods-flag
|
||||
;; Optimizing step:
|
||||
;;
|
||||
;; If this method, after this setup, only has primary methods, then
|
||||
;; we can setup the generic that way.
|
||||
(let ((doc-string (documentation method 'raw)))
|
||||
(put method 'function-documentation doc-string)
|
||||
;; Use `defalias' so as to interact properly with nadvice.el.
|
||||
(defalias method
|
||||
(if (generic-primary-only-p method)
|
||||
;; If there is only one primary method, then we can go one more
|
||||
;; optimization step.
|
||||
(if (generic-primary-only-one-p method)
|
||||
(let* ((M (get method 'eieio-method-tree))
|
||||
(entry (car (aref M eieio--method-primary))))
|
||||
(eieio--defgeneric-form-primary-only-one
|
||||
method (car entry) (cdr entry)))
|
||||
(eieio--defgeneric-form-primary-only method))
|
||||
(eieio-defgeneric-form method))))))
|
||||
|
||||
(defun eieio--defmethod (method kind argclass code)
|
||||
"Work part of the `defmethod' macro defining METHOD with ARGS."
|
||||
(let ((key
|
||||
|
|
@ -1272,18 +1277,7 @@ but remove reference to all implementations of METHOD."
|
|||
(eieiomt-add method code key argclass)
|
||||
)
|
||||
|
||||
(when eieio-optimize-primary-methods-flag
|
||||
;; Optimizing step:
|
||||
;;
|
||||
;; If this method, after this setup, only has primary methods, then
|
||||
;; we can setup the generic that way.
|
||||
(if (generic-primary-only-p method)
|
||||
;; If there is only one primary method, then we can go one more
|
||||
;; optimization step.
|
||||
(if (generic-primary-only-one-p method)
|
||||
(eieio-defgeneric-reset-generic-form-primary-only-one method)
|
||||
(eieio-defgeneric-reset-generic-form-primary-only method))
|
||||
(eieio-defgeneric-reset-generic-form method)))
|
||||
(eieio--method-optimize-primary method)
|
||||
|
||||
method)
|
||||
|
||||
|
|
@ -1293,13 +1287,13 @@ but remove reference to all implementations of METHOD."
|
|||
;; requiring the CL library at run-time. It can be eliminated if/when
|
||||
;; `typep' is merged into Emacs core.
|
||||
|
||||
(defun eieio-perform-slot-validation (spec value)
|
||||
(defun eieio--perform-slot-validation (spec value)
|
||||
"Return non-nil if SPEC does not match VALUE."
|
||||
(or (eq spec t) ; t always passes
|
||||
(eq value eieio-unbound) ; unbound always passes
|
||||
(cl-typep value spec)))
|
||||
|
||||
(defun eieio-validate-slot-value (class slot-idx value slot)
|
||||
(defun eieio--validate-slot-value (class slot-idx value slot)
|
||||
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
|
||||
Checks the :type specifier.
|
||||
SLOT is the slot that is being checked, and is only used when throwing
|
||||
|
|
@ -1308,21 +1302,23 @@ an error."
|
|||
nil
|
||||
;; Trim off object IDX junk added in for the object index.
|
||||
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
|
||||
(let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx)))
|
||||
(if (not (eieio-perform-slot-validation st value))
|
||||
(signal 'invalid-slot-type (list class slot st value))))))
|
||||
(let ((st (aref (eieio--class-public-type class) slot-idx)))
|
||||
(if (not (eieio--perform-slot-validation st value))
|
||||
(signal 'invalid-slot-type
|
||||
(list (eieio--class-symbol class) slot st value))))))
|
||||
|
||||
(defun eieio-validate-class-slot-value (class slot-idx value slot)
|
||||
(defun eieio--validate-class-slot-value (class slot-idx value slot)
|
||||
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
|
||||
Checks the :type specifier.
|
||||
SLOT is the slot that is being checked, and is only used when throwing
|
||||
an error."
|
||||
(if eieio-skip-typecheck
|
||||
nil
|
||||
(let ((st (aref (eieio--class-class-allocation-type (eieio--class-v class))
|
||||
(let ((st (aref (eieio--class-class-allocation-type class)
|
||||
slot-idx)))
|
||||
(if (not (eieio-perform-slot-validation st value))
|
||||
(signal 'invalid-slot-type (list class slot st value))))))
|
||||
(if (not (eieio--perform-slot-validation st value))
|
||||
(signal 'invalid-slot-type
|
||||
(list (eieio--class-symbol class) slot st value))))))
|
||||
|
||||
(defun eieio-barf-if-slot-unbound (value instance slotname fn)
|
||||
"Throw a signal if VALUE is a representation of an UNBOUND slot.
|
||||
|
|
@ -1389,6 +1385,8 @@ Fills in OBJ's SLOT with its default value."
|
|||
|
||||
(defun eieio-default-eval-maybe (val)
|
||||
"Check VAL, and return what `oref-default' would provide."
|
||||
;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate
|
||||
;; variables as well? Why not just always call `eval'?
|
||||
(cond
|
||||
;; Is it a function call? If so, evaluate it.
|
||||
((eieio-eval-default-p val)
|
||||
|
|
@ -1413,41 +1411,41 @@ Fills in OBJ's SLOT with VALUE."
|
|||
(eieio--class-slot-name-index class slot))
|
||||
;; Oset that slot.
|
||||
(progn
|
||||
(eieio-validate-class-slot-value (eieio--class-symbol class)
|
||||
c value slot)
|
||||
(eieio--validate-class-slot-value class c value slot)
|
||||
(aset (eieio--class-class-allocation-values class)
|
||||
c value))
|
||||
;; See oref for comment on `slot-missing'
|
||||
(slot-missing obj slot 'oset value)
|
||||
;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
|
||||
)
|
||||
(eieio-validate-slot-value (eieio--class-symbol class) c value slot)
|
||||
(eieio--validate-slot-value class c value slot)
|
||||
(aset obj c value))))
|
||||
|
||||
(defun eieio-oset-default (class slot value)
|
||||
"Do the work for the macro `oset-default'.
|
||||
Fills in the default value in CLASS' in SLOT with VALUE."
|
||||
(eieio--check-type class-p class)
|
||||
(setq class (eieio--class-object class))
|
||||
(eieio--check-type eieio--class-p class)
|
||||
(eieio--check-type symbolp slot)
|
||||
(eieio--with-scoped-class (eieio--class-v class)
|
||||
(let* ((c (eieio--slot-name-index (eieio--class-v class) nil slot)))
|
||||
(eieio--with-scoped-class class
|
||||
(let* ((c (eieio--slot-name-index class nil slot)))
|
||||
(if (not c)
|
||||
;; It might be missing because it is a :class allocated slot.
|
||||
;; Let's check that info out.
|
||||
(if (setq c (eieio--class-slot-name-index (eieio--class-v class) slot))
|
||||
(if (setq c (eieio--class-slot-name-index class slot))
|
||||
(progn
|
||||
;; Oref that slot.
|
||||
(eieio-validate-class-slot-value class c value slot)
|
||||
(aset (eieio--class-class-allocation-values (eieio--class-v class)) c
|
||||
(eieio--validate-class-slot-value class c value slot)
|
||||
(aset (eieio--class-class-allocation-values class) c
|
||||
value))
|
||||
(signal 'invalid-slot-name (list (eieio-class-name class) slot)))
|
||||
(eieio-validate-slot-value class c value slot)
|
||||
(signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
|
||||
(eieio--validate-slot-value class c value slot)
|
||||
;; Set this into the storage for defaults.
|
||||
(setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
|
||||
(eieio--class-public-d (eieio--class-v class)))
|
||||
(eieio--class-public-d class))
|
||||
value)
|
||||
;; Take the value, and put it into our cache object.
|
||||
(eieio-oset (eieio--class-default-object-cache (eieio--class-v class))
|
||||
(eieio-oset (eieio--class-default-object-cache class)
|
||||
slot value)
|
||||
))))
|
||||
|
||||
|
|
@ -1808,7 +1806,7 @@ This should only be called from a generic function."
|
|||
(list method args))))
|
||||
rval)))
|
||||
|
||||
(defun eieio-generic-call-primary-only (method args)
|
||||
(defun eieio--generic-call-primary-only (method args)
|
||||
"Call METHOD with ARGS for methods with only :PRIMARY implementations.
|
||||
ARGS provides the context on which implementation to use.
|
||||
This should only be called from a generic function.
|
||||
|
|
@ -2124,18 +2122,7 @@ is memorized for faster future use."
|
|||
key argclass))
|
||||
)
|
||||
|
||||
(when eieio-optimize-primary-methods-flag
|
||||
;; Optimizing step:
|
||||
;;
|
||||
;; If this method, after this setup, only has primary methods, then
|
||||
;; we can setup the generic that way.
|
||||
(if (generic-primary-only-p method)
|
||||
;; If there is only one primary method, then we can go one more
|
||||
;; optimization step.
|
||||
(if (generic-primary-only-one-p method)
|
||||
(eieio-defgeneric-reset-generic-form-primary-only-one method)
|
||||
(eieio-defgeneric-reset-generic-form-primary-only method))
|
||||
(eieio-defgeneric-reset-generic-form method)))
|
||||
(eieio--method-optimize-primary method)
|
||||
|
||||
method)
|
||||
(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
|
||||
|
|
|
|||
|
|
@ -221,7 +221,7 @@ Outputs to the current buffer."
|
|||
(cl-mapcan
|
||||
(lambda (c)
|
||||
(append (list c) (eieio-build-class-list c)))
|
||||
(eieio-class-children-fast class))
|
||||
(eieio--class-children (eieio--class-v class)))
|
||||
(list class)))
|
||||
|
||||
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
|
||||
|
|
@ -423,16 +423,10 @@ function has no documentation, then return nil."
|
|||
(defvar eieio-read-generic nil
|
||||
"History of the `eieio-read-generic' prompt.")
|
||||
|
||||
(defun eieio-read-generic-p (fn)
|
||||
"Function used in function `eieio-read-generic'.
|
||||
This is because `generic-p' is a macro.
|
||||
Argument FN is the function to test."
|
||||
(generic-p fn))
|
||||
|
||||
(defun eieio-read-generic (prompt &optional historyvar)
|
||||
"Read a generic function from the minibuffer with PROMPT.
|
||||
Optional argument HISTORYVAR is the variable to use as history."
|
||||
(intern (completing-read prompt obarray 'eieio-read-generic-p
|
||||
(intern (completing-read prompt obarray #'generic-p
|
||||
t nil (or historyvar 'eieio-read-generic))))
|
||||
|
||||
;;; METHOD STATS
|
||||
|
|
|
|||
|
|
@ -328,7 +328,7 @@ The CLOS function `class-direct-superclasses' is aliased to this function."
|
|||
"Return child classes to CLASS.
|
||||
The CLOS function `class-direct-subclasses' is aliased to this function."
|
||||
(eieio--check-type class-p class)
|
||||
(eieio-class-children-fast class))
|
||||
(eieio--class-children (eieio--class-v class)))
|
||||
(define-obsolete-function-alias
|
||||
'class-children #'eieio-class-children "24.4")
|
||||
|
||||
|
|
@ -343,10 +343,12 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
|
|||
`(car (eieio-class-parents ,class)))
|
||||
(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4")
|
||||
|
||||
(defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS."
|
||||
(eieio--check-type class-p class)
|
||||
(defun same-class-p (obj class)
|
||||
"Return t if OBJ is of class-type CLASS."
|
||||
(setq class (eieio--class-object class))
|
||||
(eieio--check-type eieio--class-p class)
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(same-class-fast-p obj class))
|
||||
(eq (eieio--object-class-object obj) class))
|
||||
|
||||
(defun object-of-class-p (obj class)
|
||||
"Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
|
||||
|
|
@ -546,7 +548,7 @@ Use `next-method-p' to find out if there is a next method to call."
|
|||
(next (car eieio-generic-call-next-method-list))
|
||||
)
|
||||
(if (not (and next (car next)))
|
||||
(apply #'no-next-method (car newargs) (cdr newargs))
|
||||
(apply #'no-next-method newargs)
|
||||
(let* ((eieio-generic-call-next-method-list
|
||||
(cdr eieio-generic-call-next-method-list))
|
||||
(eieio-generic-call-arglst newargs)
|
||||
|
|
@ -723,7 +725,8 @@ first and modify the returned object.")
|
|||
"Make a copy of OBJ, and then apply PARAMS."
|
||||
(let ((nobj (copy-sequence obj)))
|
||||
(if (stringp (car params))
|
||||
(message "Obsolete name %S passed to clone" (pop params)))
|
||||
(funcall (if eieio-backward-compatibility #'ignore #'message)
|
||||
"Obsolete name %S passed to clone" (pop params)))
|
||||
(if params (shared-initialize nobj params))
|
||||
nobj))
|
||||
|
||||
|
|
@ -889,7 +892,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
|
|||
|
||||
;;; Start of automatically extracted autoloads.
|
||||
|
||||
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "a3f314e2a27e52444df4597c6ae51458")
|
||||
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "7d3c0bca065713ae74af0c07778dd1f4")
|
||||
;;; Generated autoloads from eieio-custom.el
|
||||
|
||||
(autoload 'customize-object "eieio-custom" "\
|
||||
|
|
@ -900,7 +903,7 @@ Optional argument GROUP is the sub-group of slots to display.
|
|||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "2ff7d98da3f84c6af5c873ffb781930e")
|
||||
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6377e022e85d377b399f44c98b4eab4a")
|
||||
;;; Generated autoloads from eieio-opt.el
|
||||
|
||||
(autoload 'eieio-browse "eieio-opt" "\
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue