EIEIO: Simplify help hyperlinks; Try and reduce hardcoding in .elc
* lisp/emacs-lisp/cl-generic.el (cl--generic-search-method): Fix regexp. * lisp/emacs-lisp/eieio-core.el (eieio--check-type): Remove. Use cl-check-type everywhere instead. (eieio-class-object): Remove, use find-class instead when needed. (class-p): Don't inline. (eieio-object-p): Check more thoroughly, so we don't treat cl-structs, such as eieio classes, as objects. Don't inline. (object-p): Mark as obsolete. (eieio-defclass-autoload, eieio-defclass-internal, eieio-oref) (eieio--generic-tagcode): Avoid `class-p'. (eieio-make-class-predicate, eieio-make-child-predicate): New functions. (eieio-defclass-internal): Use current-load-list rather than `class-location'. * lisp/emacs-lisp/eieio-opt.el (eieio-help-class, eieio-help-constructor): Use find-lisp-object-file-name, help-fns-short-filename and new calling convention for eieio-class-def. (eieio-build-class-list): Remove function, unused. (eieio-method-def): Remove button type, unused. (eieio-class-def): Inherit from help-function-def. (eieio--defclass-regexp): New constant. (find-function-regexp-alist): Use it. (eieio--specializers-apply-to-class-p): Handle eieio--static as well. (eieio-help-find-method-definition, eieio-help-find-class-definition): Remove functions. * lisp/emacs-lisp/eieio.el (defclass): Use new eieio-make-class-predicate and eieio-make-child-predicate. (eieio-class-parents): Use eieio--class-object. (slot-boundp, find-class, eieio-override-prin1): Avoid class-p. (slot-exists-p): Use find-class. * test/automated/eieio-tests.el (eieio-test-23-inheritance-check): Simplify.
This commit is contained in:
Stefan Monnier
parent
d5e3922e08
commit
e0be229d5f
9 changed files with 145 additions and 189 deletions
|
|
@ -1,3 +1,38 @@
|
|||
2015-01-31 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/eieio.el (defclass): Use new eieio-make-class-predicate
|
||||
and eieio-make-child-predicate.
|
||||
(eieio-class-parents): Use eieio--class-object.
|
||||
(slot-boundp, find-class, eieio-override-prin1): Avoid class-p.
|
||||
(slot-exists-p): Use find-class.
|
||||
|
||||
* emacs-lisp/eieio-opt.el (eieio-help-class, eieio-help-constructor):
|
||||
Use find-lisp-object-file-name, help-fns-short-filename and new calling
|
||||
convention for eieio-class-def.
|
||||
(eieio-build-class-list): Remove function, unused.
|
||||
(eieio-method-def): Remove button type, unused.
|
||||
(eieio-class-def): Inherit from help-function-def.
|
||||
(eieio--defclass-regexp): New constant.
|
||||
(find-function-regexp-alist): Use it.
|
||||
(eieio--specializers-apply-to-class-p): Handle eieio--static as well.
|
||||
(eieio-help-find-method-definition, eieio-help-find-class-definition):
|
||||
Remove functions.
|
||||
|
||||
* emacs-lisp/eieio-core.el (eieio--check-type): Remove.
|
||||
Use cl-check-type everywhere instead.
|
||||
(eieio-class-object): Remove, use find-class instead when needed.
|
||||
(class-p): Don't inline.
|
||||
(eieio-object-p): Check more thoroughly, so we don't treat cl-structs,
|
||||
such as eieio classes, as objects. Don't inline.
|
||||
(object-p): Mark as obsolete.
|
||||
(eieio-defclass-autoload, eieio-defclass-internal, eieio-oref)
|
||||
(eieio--generic-tagcode): Avoid `class-p'.
|
||||
(eieio-make-class-predicate, eieio-make-child-predicate): New functions.
|
||||
(eieio-defclass-internal): Use current-load-list rather than
|
||||
`class-location'.
|
||||
|
||||
* emacs-lisp/cl-generic.el (cl--generic-search-method): Fix regexp.
|
||||
|
||||
2015-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/backquote.el (backquote-delay-process): Don't reuse `s'
|
||||
|
|
|
|||
|
|
@ -635,7 +635,8 @@ Can only be used from within the lexical body of a primary or around method."
|
|||
|
||||
(defun cl--generic-search-method (met-name)
|
||||
(let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
|
||||
(regexp-quote (format "%s\\_>" (car met-name))))))
|
||||
(regexp-quote (format "%s" (car met-name)))
|
||||
"\\_>")))
|
||||
(or
|
||||
(re-search-forward
|
||||
(concat base-re "[^&\"\n]*"
|
||||
|
|
|
|||
|
|
@ -219,7 +219,7 @@ for CLASS. Optional ALLOW-SUBCLASS says that it is ok for
|
|||
being pedantic."
|
||||
(unless class
|
||||
(message "Unsafe call to `eieio-persistent-read'."))
|
||||
(when class (eieio--check-type class-p class))
|
||||
(when class (cl-check-type class class))
|
||||
(let ((ret nil)
|
||||
(buffstr nil))
|
||||
(unwind-protect
|
||||
|
|
@ -481,7 +481,7 @@ instance."
|
|||
|
||||
(cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
|
||||
"Set the string which is OBJ's NAME."
|
||||
(eieio--check-type stringp name)
|
||||
(cl-check-type name string)
|
||||
(eieio-oset obj 'object-name name))
|
||||
|
||||
(cl-defmethod clone ((obj eieio-named) &rest params)
|
||||
|
|
|
|||
|
|
@ -40,6 +40,8 @@
|
|||
(declare-function slot-unbound "eieio")
|
||||
(declare-function slot-missing "eieio")
|
||||
(declare-function child-of-class-p "eieio")
|
||||
(declare-function same-class-p "eieio")
|
||||
(declare-function object-of-class-p "eieio")
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -154,15 +156,6 @@ Currently under control of this var:
|
|||
|
||||
|
||||
;;; Important macros used internally in eieio.
|
||||
;;
|
||||
(defmacro eieio--check-type (type obj)
|
||||
(unless (symbolp obj)
|
||||
(error "eieio--check-type wants OBJ to be a variable"))
|
||||
`(if (not ,(cond
|
||||
((eq 'or (car-safe type))
|
||||
`(or ,@(mapcar (lambda (type) `(,type ,obj)) (cdr type))))
|
||||
(t `(,type ,obj))))
|
||||
(signal 'wrong-type-argument (list ',type ,obj))))
|
||||
|
||||
(defmacro eieio--class-v (class) ;Use a macro, so it acts as a GV place.
|
||||
"Internal: Return the class vector from the CLASS symbol."
|
||||
|
|
@ -183,27 +176,17 @@ Currently under control of this var:
|
|||
(eq (aref class 0) 'defclass)
|
||||
(error nil)))
|
||||
|
||||
(defsubst eieio-class-object (class)
|
||||
"Check that CLASS is a class and return the corresponding object."
|
||||
(let ((c (eieio--class-object class)))
|
||||
(eieio--check-type eieio--class-p c)
|
||||
c))
|
||||
|
||||
(defsubst class-p (class)
|
||||
(defun class-p (class)
|
||||
"Return non-nil if CLASS is a valid class vector.
|
||||
CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
|
||||
;; this new method is faster since it doesn't waste time checking lots of
|
||||
;; things.
|
||||
(condition-case nil
|
||||
(eq (aref (eieio--class-v class) 0) 'defclass)
|
||||
(error nil)))
|
||||
(and (symbolp class) (eieio--class-p (eieio--class-v class))))
|
||||
|
||||
(defun eieio-class-name (class)
|
||||
"Return a Lisp like symbol name for CLASS."
|
||||
;; FIXME: What's a "Lisp like symbol name"?
|
||||
;; FIXME: CLOS returns a symbol, but the code returns a string.
|
||||
(if (eieio--class-p class) (setq class (eieio--class-symbol class)))
|
||||
(eieio--check-type class-p class)
|
||||
(cl-check-type class class)
|
||||
;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
|
||||
;; and I wanted a string. Arg!
|
||||
(format "#<class %s>" (symbol-name class)))
|
||||
|
|
@ -221,14 +204,17 @@ CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
|
|||
Return nil if that option doesn't exist."
|
||||
(eieio--class-option-assoc (eieio--class-options class) option))
|
||||
|
||||
(defsubst eieio-object-p (obj)
|
||||
(defun eieio-object-p (obj)
|
||||
"Return non-nil if OBJ is an EIEIO object."
|
||||
(and (vectorp obj)
|
||||
(> (length obj) 0)
|
||||
(eq (symbol-function (eieio--class-tag obj))
|
||||
:quick-object-witness-check)))
|
||||
(let ((tag (eieio--object-class-tag obj)))
|
||||
(and (symbolp tag)
|
||||
;; (eq (symbol-function tag) :quick-object-witness-check)
|
||||
(boundp tag)
|
||||
(eieio--class-p (symbol-value tag))))))
|
||||
|
||||
(defalias 'object-p 'eieio-object-p)
|
||||
(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
|
||||
|
||||
(defsubst class-abstract-p (class)
|
||||
"Return non-nil if CLASS is abstract.
|
||||
|
|
@ -266,10 +252,9 @@ It creates an autoload function for CNAME's constructor."
|
|||
;; simply not exist yet. So instead we just don't store the list of parents
|
||||
;; here in eieio-defclass-autoload at all, since it seems that they're just
|
||||
;; not needed before the class is actually loaded.
|
||||
(let* ((oldc (when (class-p cname) (eieio--class-v cname)))
|
||||
(newc (eieio--class-make cname))
|
||||
)
|
||||
(if oldc
|
||||
(let* ((oldc (eieio--class-v cname))
|
||||
(newc (eieio--class-make cname)))
|
||||
(if (eieio--class-p oldc)
|
||||
nil ;; Do nothing if we already have this class.
|
||||
|
||||
;; turn this into a usable self-pointing symbol
|
||||
|
|
@ -300,7 +285,21 @@ It creates an autoload function for CNAME's constructor."
|
|||
(cl-every (lambda (elem) (cl-typep elem ',elem-type))
|
||||
list)))))
|
||||
|
||||
(declare-function eieio--defmethod "eieio-generic" (method kind argclass code))
|
||||
|
||||
(defun eieio-make-class-predicate (class)
|
||||
(lambda (obj)
|
||||
;; (:docstring (format "Test OBJ to see if it's an object of type %S."
|
||||
;; class))
|
||||
(and (eieio-object-p obj)
|
||||
(same-class-p obj class))))
|
||||
|
||||
(defun eieio-make-child-predicate (class)
|
||||
(lambda (obj)
|
||||
;; (:docstring (format
|
||||
;; "Test OBJ to see if it's an object is a child of type %S."
|
||||
;; class))
|
||||
(and (eieio-object-p obj)
|
||||
(object-of-class-p obj class))))
|
||||
|
||||
(defun eieio-defclass-internal (cname superclasses slots options)
|
||||
"Define CNAME as a new subclass of SUPERCLASSES.
|
||||
|
|
@ -314,7 +313,7 @@ See `defclass' for more information."
|
|||
(setq eieio-hook nil)
|
||||
|
||||
(let* ((pname superclasses)
|
||||
(oldc (when (class-p cname) (eieio--class-v cname)))
|
||||
(oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c)))
|
||||
(newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
|
||||
;; The oldc class is a stub setup by eieio-defclass-autoload.
|
||||
;; Reuse it instead of creating a new one, so that existing
|
||||
|
|
@ -342,19 +341,20 @@ See `defclass' for more information."
|
|||
(if pname
|
||||
(progn
|
||||
(dolist (p pname)
|
||||
(if (and p (symbolp p))
|
||||
(if (not (class-p p))
|
||||
(if (not (and p (symbolp p)))
|
||||
(error "Invalid parent class %S" p)
|
||||
(let ((c (eieio--class-v p)))
|
||||
(if (not (eieio--class-p c))
|
||||
;; bad class
|
||||
(error "Given parent class %S is not a class" p)
|
||||
;; good parent class...
|
||||
;; save new child in parent
|
||||
(cl-pushnew cname (eieio--class-children (eieio--class-v p)))
|
||||
(cl-pushnew cname (eieio--class-children c))
|
||||
;; Get custom groups, and store them into our local copy.
|
||||
(mapc (lambda (g) (cl-pushnew g groups :test #'equal))
|
||||
(eieio--class-option (eieio--class-v p) :custom-groups))
|
||||
;; save parent in child
|
||||
(push (eieio--class-v p) (eieio--class-parent newc)))
|
||||
(error "Invalid parent class %S" p)))
|
||||
(eieio--class-option c :custom-groups))
|
||||
;; Save parent in child.
|
||||
(push c (eieio--class-parent newc))))))
|
||||
;; Reverse the list of our parents so that they are prioritized in
|
||||
;; the same order as specified in the code.
|
||||
(cl-callf nreverse (eieio--class-parent newc)))
|
||||
|
|
@ -506,13 +506,7 @@ See `defclass' for more information."
|
|||
(eieio--class-option-assoc options :documentation))
|
||||
|
||||
;; Save the file location where this class is defined.
|
||||
(let ((fname (if load-in-progress
|
||||
load-file-name
|
||||
buffer-file-name)))
|
||||
(when fname
|
||||
(when (string-match "\\.elc\\'" fname)
|
||||
(setq fname (substring fname 0 (1- (length fname)))))
|
||||
(put cname 'class-location fname)))
|
||||
(add-to-list 'current-load-list `(eieio-defclass . ,cname))
|
||||
|
||||
;; We have a list of custom groups. Store them into the options.
|
||||
(let ((g (eieio--class-option-assoc options :custom-groups)))
|
||||
|
|
@ -909,12 +903,13 @@ Argument FN is the function calling this verifier."
|
|||
;;
|
||||
(defun eieio-oref (obj slot)
|
||||
"Return the value in OBJ at SLOT in the object vector."
|
||||
(eieio--check-type (or eieio-object-p class-p) obj)
|
||||
(eieio--check-type symbolp slot)
|
||||
(if (class-p obj) (eieio-class-un-autoload obj))
|
||||
(cl-check-type slot symbol)
|
||||
(cl-check-type obj (or eieio-object class))
|
||||
(let* ((class (cond ((symbolp obj)
|
||||
(error "eieio-oref called on a class!")
|
||||
(eieio--class-v obj))
|
||||
(let ((c (eieio--class-v obj)))
|
||||
(if (eieio--class-p c) (eieio-class-un-autoload obj))
|
||||
c))
|
||||
(t (eieio--object-class-object obj))))
|
||||
(c (eieio--slot-name-index class obj slot)))
|
||||
(if (not c)
|
||||
|
|
@ -929,15 +924,15 @@ Argument FN is the function calling this verifier."
|
|||
(slot-missing obj slot 'oref)
|
||||
;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
|
||||
)
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(cl-check-type obj eieio-object)
|
||||
(eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
|
||||
|
||||
|
||||
(defun eieio-oref-default (obj slot)
|
||||
"Do the work for the macro `oref-default' with similar parameters.
|
||||
Fills in OBJ's SLOT with its default value."
|
||||
(eieio--check-type (or eieio-object-p class-p) obj)
|
||||
(eieio--check-type symbolp slot)
|
||||
(cl-check-type obj (or eieio-object class))
|
||||
(cl-check-type slot symbol)
|
||||
(let* ((cl (cond ((symbolp obj) (eieio--class-v obj))
|
||||
(t (eieio--object-class-object obj))))
|
||||
(c (eieio--slot-name-index cl obj slot)))
|
||||
|
|
@ -975,8 +970,8 @@ Fills in OBJ's SLOT with its default value."
|
|||
(defun eieio-oset (obj slot value)
|
||||
"Do the work for the macro `oset'.
|
||||
Fills in OBJ's SLOT with VALUE."
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(eieio--check-type symbolp slot)
|
||||
(cl-check-type obj eieio-object)
|
||||
(cl-check-type slot symbol)
|
||||
(let* ((class (eieio--object-class-object obj))
|
||||
(c (eieio--slot-name-index class obj slot)))
|
||||
(if (not c)
|
||||
|
|
@ -1000,8 +995,8 @@ Fills in OBJ's SLOT with VALUE."
|
|||
"Do the work for the macro `oset-default'.
|
||||
Fills in the default value in CLASS' in SLOT with VALUE."
|
||||
(setq class (eieio--class-object class))
|
||||
(eieio--check-type eieio--class-p class)
|
||||
(eieio--check-type symbolp slot)
|
||||
(cl-check-type class eieio--class)
|
||||
(cl-check-type slot symbol)
|
||||
(let* ((c (eieio--slot-name-index class nil slot)))
|
||||
(if (not c)
|
||||
;; It might be missing because it is a :class allocated slot.
|
||||
|
|
@ -1223,7 +1218,7 @@ method invocation orders of the involved classes."
|
|||
;; A class must be defined before it can be used as a parameter
|
||||
;; specializer in a defmethod form.
|
||||
;; So we can ignore types that are not known to denote classes.
|
||||
(and (class-p type)
|
||||
(and (eieio--class-p (eieio--class-object type))
|
||||
;; Use the exact same code as for cl-struct, so that methods
|
||||
;; that dispatch on both kinds of objects get to share this
|
||||
;; part of the dispatch code.
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
|
|||
(setq publa (cdr publa)))))))
|
||||
|
||||
;;; Augment the Data debug thing display list.
|
||||
(data-debug-add-specialized-thing (lambda (thing) (object-p thing))
|
||||
(data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing))
|
||||
#'data-debug-insert-object-button)
|
||||
|
||||
;;; DEBUG METHODS
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ variable `eieio-default-superclass'."
|
|||
nil t)))
|
||||
nil))
|
||||
(if (not root-class) (setq root-class 'eieio-default-superclass))
|
||||
(eieio--check-type class-p root-class)
|
||||
(cl-check-type root-class class)
|
||||
(display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
|
||||
(with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*")
|
||||
(erase-buffer)
|
||||
|
|
@ -58,7 +58,7 @@ variable `eieio-default-superclass'."
|
|||
Argument THIS-ROOT is the local root of the tree.
|
||||
Argument PREFIX is the character prefix to use.
|
||||
Argument CH-PREFIX is another character prefix to display."
|
||||
(eieio--check-type class-p this-root)
|
||||
(cl-check-type this-root class)
|
||||
(let ((myname (symbol-name this-root))
|
||||
(chl (eieio--class-children (eieio--class-v this-root)))
|
||||
(fprefix (concat ch-prefix " +--"))
|
||||
|
|
@ -85,12 +85,12 @@ If CLASS is actually an object, then also display current values of that object.
|
|||
"n abstract"
|
||||
"")
|
||||
" class")
|
||||
(let ((location (get class 'class-location)))
|
||||
(let ((location (find-lisp-object-file-name class 'eieio-defclass)))
|
||||
(when location
|
||||
(insert " in `")
|
||||
(help-insert-xref-button
|
||||
(file-name-nondirectory location)
|
||||
'eieio-class-def class location)
|
||||
(help-fns-short-filename location)
|
||||
'eieio-class-def class location 'eieio-defclass)
|
||||
(insert "'")))
|
||||
(insert ".\n")
|
||||
;; Parents
|
||||
|
|
@ -204,15 +204,6 @@ Outputs to the current buffer."
|
|||
prot (cdr prot)
|
||||
i (1+ i)))))
|
||||
|
||||
(defun eieio-build-class-list (class)
|
||||
"Return a list of all classes that inherit from CLASS."
|
||||
(if (class-p class)
|
||||
(cl-mapcan
|
||||
(lambda (c)
|
||||
(append (list c) (eieio-build-class-list c)))
|
||||
(eieio--class-children (eieio--class-v class)))
|
||||
(list class)))
|
||||
|
||||
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
|
||||
"Return an alist of all currently active classes for completion purposes.
|
||||
Optional argument CLASS is the class to start with.
|
||||
|
|
@ -256,24 +247,22 @@ are not abstract."
|
|||
|
||||
;;; METHOD COMPLETION / DOC
|
||||
|
||||
(define-button-type 'eieio-method-def
|
||||
:supertype 'help-xref
|
||||
'help-function (lambda (class method file)
|
||||
(eieio-help-find-method-definition class method file))
|
||||
'help-echo (purecopy "mouse-2, RET: find method's definition"))
|
||||
|
||||
(define-button-type 'eieio-class-def
|
||||
:supertype 'help-xref
|
||||
'help-function (lambda (class file)
|
||||
(eieio-help-find-class-definition class file))
|
||||
:supertype 'help-function-def
|
||||
'help-echo (purecopy "mouse-2, RET: find class definition"))
|
||||
|
||||
(defconst eieio--defclass-regexp "(defclass[ \t\r\n]+%s[ \t\r\n]+")
|
||||
(with-eval-after-load 'find-func
|
||||
(defvar find-function-regexp-alist)
|
||||
(add-to-list 'find-function-regexp-alist
|
||||
`(eieio-defclass . eieio--defclass-regexp)))
|
||||
|
||||
;;;###autoload
|
||||
(defun eieio-help-constructor (ctr)
|
||||
"Describe CTR if it is a class constructor."
|
||||
(when (class-p ctr)
|
||||
(erase-buffer)
|
||||
(let ((location (get ctr 'class-location))
|
||||
(let ((location (find-lisp-object-file-name ctr 'eieio-defclass))
|
||||
(def (symbol-function ctr)))
|
||||
(goto-char (point-min))
|
||||
(prin1 ctr)
|
||||
|
|
@ -288,8 +277,8 @@ are not abstract."
|
|||
(when location
|
||||
(insert " in `")
|
||||
(help-insert-xref-button
|
||||
(file-name-nondirectory location)
|
||||
'eieio-class-def ctr location)
|
||||
(help-fns-short-filename location)
|
||||
'eieio-class-def ctr location 'eieio-defclass)
|
||||
(insert "'"))
|
||||
(insert ".\nCreates an object of class " (symbol-name ctr) ".")
|
||||
(goto-char (point-max))
|
||||
|
|
@ -304,7 +293,7 @@ are not abstract."
|
|||
"Return non-nil if a method with SPECIALIZERS applies to CLASS."
|
||||
(let ((applies nil))
|
||||
(dolist (specializer specializers)
|
||||
(if (eq 'subclass (car-safe specializer))
|
||||
(if (memq (car-safe specializer) '(subclass eieio--static))
|
||||
(setq specializer (nth 1 specializer)))
|
||||
;; Don't include the methods that are "too generic", such as those
|
||||
;; applying to `eieio-default-superclass'.
|
||||
|
|
@ -443,60 +432,6 @@ The value returned is a list of elements of the form
|
|||
(terpri)
|
||||
))
|
||||
|
||||
;;; HELP AUGMENTATION
|
||||
;;
|
||||
(defun eieio-help-find-method-definition (class method file)
|
||||
(let ((filename (find-library-name file))
|
||||
location buf)
|
||||
(when (symbolp class)
|
||||
(setq class (symbol-name class)))
|
||||
(when (symbolp method)
|
||||
(setq method (symbol-name method)))
|
||||
(when (null filename)
|
||||
(error "Cannot find library %s" file))
|
||||
(setq buf (find-file-noselect filename))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-min))
|
||||
(when
|
||||
(re-search-forward
|
||||
;; Regexp for searching methods.
|
||||
(concat "(defmethod[ \t\r\n]+" method
|
||||
"\\([ \t\r\n]+:[a-zA-Z]+\\)?"
|
||||
"[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
|
||||
class
|
||||
"\\s-*)")
|
||||
nil t)
|
||||
(setq location (match-beginning 0))))
|
||||
(if (null location)
|
||||
(message "Unable to find location in file")
|
||||
(pop-to-buffer buf)
|
||||
(goto-char location)
|
||||
(recenter)
|
||||
(beginning-of-line))))
|
||||
|
||||
(defun eieio-help-find-class-definition (class file)
|
||||
(when (symbolp class)
|
||||
(setq class (symbol-name class)))
|
||||
(let ((filename (find-library-name file))
|
||||
location buf)
|
||||
(when (null filename)
|
||||
(error "Cannot find library %s" file))
|
||||
(setq buf (find-file-noselect filename))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-min))
|
||||
(when
|
||||
(re-search-forward
|
||||
;; Regexp for searching a class.
|
||||
(concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
|
||||
nil t)
|
||||
(setq location (match-beginning 0))))
|
||||
(if (null location)
|
||||
(message "Unable to find location in file")
|
||||
(pop-to-buffer buf)
|
||||
(goto-char location)
|
||||
(recenter)
|
||||
(beginning-of-line))))
|
||||
|
||||
;;; SPEEDBAR SUPPORT
|
||||
;;
|
||||
|
||||
|
|
@ -546,7 +481,7 @@ current expansion depth."
|
|||
|
||||
(defun eieio-class-button (class depth)
|
||||
"Draw a speedbar button at the current point for CLASS at DEPTH."
|
||||
(eieio--check-type class-p class)
|
||||
(cl-check-type class class)
|
||||
(let ((subclasses (eieio--class-children (eieio--class-v class))))
|
||||
(if subclasses
|
||||
(speedbar-make-tag-line 'angle ?+
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
(eieio--check-type listp superclasses)
|
||||
(cl-check-type superclasses list)
|
||||
|
||||
(cond ((and (stringp (car options-and-doc))
|
||||
(/= 1 (% (length options-and-doc) 2)))
|
||||
|
|
@ -223,18 +223,9 @@ This method is obsolete."
|
|||
;; referencing classes. ei, a class whose slot can contain only
|
||||
;; pointers to itself.
|
||||
|
||||
;; Create the test function.
|
||||
(defun ,testsym1 (obj)
|
||||
,(format "Test OBJ to see if it an object of type %S." name)
|
||||
(and (eieio-object-p obj)
|
||||
(same-class-p obj ',name)))
|
||||
|
||||
(defun ,testsym2 (obj)
|
||||
,(format
|
||||
"Test OBJ to see if it an object is a child of type %S."
|
||||
name)
|
||||
(and (eieio-object-p obj)
|
||||
(object-of-class-p obj ',name)))
|
||||
;; Create the test functions.
|
||||
(defalias ',testsym1 (eieio-make-class-predicate ',name))
|
||||
(defalias ',testsym2 (eieio-make-child-predicate ',name))
|
||||
|
||||
,@(when eieio-backward-compatibility
|
||||
(let ((f (intern (format "%s-child-p" name))))
|
||||
|
|
@ -374,7 +365,7 @@ variable name of the same name as the slot."
|
|||
(defun eieio-object-name (obj &optional extra)
|
||||
"Return a Lisp like symbol string for object OBJ.
|
||||
If EXTRA, include that in the string returned to represent the symbol."
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(cl-check-type obj eieio-object)
|
||||
(format "#<%s %s%s>" (eieio--object-class-name obj)
|
||||
(eieio-object-name-string obj) (or extra "")))
|
||||
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
|
||||
|
|
@ -394,7 +385,7 @@ If EXTRA, include that in the string returned to represent the symbol."
|
|||
(cl-defmethod eieio-object-set-name-string (obj name)
|
||||
"Set the string which is OBJ's NAME."
|
||||
(declare (obsolete eieio-named "25.1"))
|
||||
(eieio--check-type stringp name)
|
||||
(cl-check-type name string)
|
||||
(setf (gethash obj eieio--object-names) name))
|
||||
(define-obsolete-function-alias
|
||||
'object-set-name-string 'eieio-object-set-name-string "24.4")
|
||||
|
|
@ -402,7 +393,7 @@ If EXTRA, include that in the string returned to represent the symbol."
|
|||
(defun eieio-object-class (obj)
|
||||
"Return the class struct defining OBJ."
|
||||
;; FIXME: We say we return a "struct" but we return a symbol instead!
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(cl-check-type obj eieio-object)
|
||||
(eieio--object-class-name obj))
|
||||
(define-obsolete-function-alias 'object-class #'eieio-object-class "24.4")
|
||||
;; CLOS name, maybe?
|
||||
|
|
@ -410,7 +401,7 @@ If EXTRA, include that in the string returned to represent the symbol."
|
|||
|
||||
(defun eieio-object-class-name (obj)
|
||||
"Return a Lisp like symbol name for OBJ's class."
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(cl-check-type obj eieio-object)
|
||||
(eieio-class-name (eieio--object-class-name obj)))
|
||||
(define-obsolete-function-alias
|
||||
'object-class-name 'eieio-object-class-name "24.4")
|
||||
|
|
@ -419,15 +410,14 @@ If EXTRA, include that in the string returned to represent the symbol."
|
|||
"Return parent classes to CLASS. (overload of variable).
|
||||
|
||||
The CLOS function `class-direct-superclasses' is aliased to this function."
|
||||
(let ((c (eieio-class-object class)))
|
||||
(eieio--class-parent c)))
|
||||
(eieio--class-parent (eieio--class-object class)))
|
||||
|
||||
(define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
|
||||
|
||||
(defun eieio-class-children (class)
|
||||
"Return child classes to CLASS.
|
||||
The CLOS function `class-direct-subclasses' is aliased to this function."
|
||||
(eieio--check-type class-p class)
|
||||
(cl-check-type class class)
|
||||
(eieio--class-children (eieio--class-v class)))
|
||||
(define-obsolete-function-alias
|
||||
'class-children #'eieio-class-children "24.4")
|
||||
|
|
@ -446,13 +436,13 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
|
|||
(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)
|
||||
(cl-check-type class eieio--class)
|
||||
(cl-check-type obj eieio-object)
|
||||
(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."
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(cl-check-type obj eieio-object)
|
||||
;; class will be checked one layer down
|
||||
(child-of-class-p (eieio--object-class-object obj) class))
|
||||
;; Backwards compatibility
|
||||
|
|
@ -461,13 +451,13 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
|
|||
(defun child-of-class-p (child class)
|
||||
"Return non-nil if CHILD class is a subclass of CLASS."
|
||||
(setq child (eieio--class-object child))
|
||||
(eieio--check-type eieio--class-p child)
|
||||
(cl-check-type child eieio--class)
|
||||
;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
|
||||
;; so we have to special case it here.
|
||||
(or (eq class 'eieio-default-superclass)
|
||||
(let ((p nil))
|
||||
(setq class (eieio--class-object class))
|
||||
(eieio--check-type eieio--class-p class)
|
||||
(cl-check-type class eieio--class)
|
||||
(while (and child (not (eq child class)))
|
||||
(setq p (append p (eieio--class-parent child))
|
||||
child (pop p)))
|
||||
|
|
@ -475,11 +465,11 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
|
|||
|
||||
(defun object-slots (obj)
|
||||
"Return list of slots available in OBJ."
|
||||
(eieio--check-type eieio-object-p obj)
|
||||
(cl-check-type obj eieio-object)
|
||||
(eieio--class-public-a (eieio--object-class-object obj)))
|
||||
|
||||
(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
|
||||
(eieio--check-type eieio--class-p class)
|
||||
(cl-check-type class eieio--class)
|
||||
(let ((ia (eieio--class-initarg-tuples class))
|
||||
(f nil))
|
||||
(while (and ia (not f))
|
||||
|
|
@ -517,7 +507,7 @@ OBJECT can be an instance or a class."
|
|||
;; Return nil if the magic symbol is in there.
|
||||
(not (eq (cond
|
||||
((eieio-object-p object) (eieio-oref object slot))
|
||||
((class-p object) (eieio-oref-default object slot))
|
||||
((symbolp object) (eieio-oref-default object slot))
|
||||
(t (signal 'wrong-type-argument (list 'eieio-object-p object))))
|
||||
eieio-unbound))))
|
||||
|
||||
|
|
@ -529,7 +519,8 @@ OBJECT can be an instance or a class."
|
|||
"Return non-nil if OBJECT-OR-CLASS has SLOT."
|
||||
(let ((cv (cond ((eieio-object-p object-or-class)
|
||||
(eieio--object-class-object object-or-class))
|
||||
(t (eieio-class-object object-or-class)))))
|
||||
((eieio--class-p object-or-class) object-or-class)
|
||||
(t (find-class object-or-class 'error)))))
|
||||
(or (memq slot (eieio--class-public-a cv))
|
||||
(memq slot (eieio--class-class-allocation-a cv)))
|
||||
))
|
||||
|
|
@ -538,10 +529,10 @@ OBJECT can be an instance or a class."
|
|||
"Return the class that SYMBOL represents.
|
||||
If there is no class, nil is returned if ERRORP is nil.
|
||||
If ERRORP is non-nil, `wrong-argument-type' is signaled."
|
||||
(if (not (class-p symbol))
|
||||
(if errorp (signal 'wrong-type-argument (list 'class-p symbol))
|
||||
nil)
|
||||
(eieio--class-v symbol)))
|
||||
(let ((class (eieio--class-v symbol)))
|
||||
(cond
|
||||
((eieio--class-p class) class)
|
||||
(errorp (signal 'wrong-type-argument (list 'class-p symbol))))))
|
||||
|
||||
;;; Slightly more complex utility functions for objects
|
||||
;;
|
||||
|
|
@ -551,7 +542,7 @@ LIST is a list of objects whose slots are searched.
|
|||
Objects in LIST do not need to have a slot named SLOT, nor does
|
||||
SLOT need to be bound. If these errors occur, those objects will
|
||||
be ignored."
|
||||
(eieio--check-type listp list)
|
||||
(cl-check-type list list)
|
||||
(while (and list (not (condition-case nil
|
||||
;; This prevents errors for missing slots.
|
||||
(equal key (eieio-oref (car list) slot))
|
||||
|
|
@ -563,7 +554,7 @@ be ignored."
|
|||
"Return an association list with the contents of SLOT as the key element.
|
||||
LIST must be a list of objects with SLOT in it.
|
||||
This is useful when you need to do completing read on an object group."
|
||||
(eieio--check-type listp list)
|
||||
(cl-check-type list list)
|
||||
(let ((assoclist nil))
|
||||
(while list
|
||||
(setq assoclist (cons (cons (eieio-oref (car list) slot)
|
||||
|
|
@ -577,7 +568,7 @@ This is useful when you need to do completing read on an object group."
|
|||
LIST must be a list of objects, but those objects do not need to have
|
||||
SLOT in it. If it does not, then that element is left out of the association
|
||||
list."
|
||||
(eieio--check-type listp list)
|
||||
(cl-check-type list list)
|
||||
(let ((assoclist nil))
|
||||
(while list
|
||||
(if (slot-exists-p (car list) slot)
|
||||
|
|
@ -869,12 +860,8 @@ this object."
|
|||
(object-write thing))
|
||||
((consp thing)
|
||||
(eieio-list-prin1 thing))
|
||||
((class-p thing)
|
||||
((eieio--class-p thing)
|
||||
(princ (eieio-class-name thing)))
|
||||
((or (keywordp thing) (booleanp thing))
|
||||
(prin1 thing))
|
||||
((symbolp thing)
|
||||
(princ (concat "'" (symbol-name thing))))
|
||||
(t (prin1 thing))))
|
||||
|
||||
(defun eieio-list-prin1 (list)
|
||||
|
|
@ -942,7 +929,7 @@ Optional argument GROUP is the sub-group of slots to display.
|
|||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "b849f8bf1312d5ef57e53d02173e4b5a")
|
||||
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "ff1097f185bc2c253276a7d19fe2f54a")
|
||||
;;; Generated autoloads from eieio-opt.el
|
||||
|
||||
(autoload 'eieio-browse "eieio-opt" "\
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2015-01-31 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/eieio-tests.el (eieio-test-23-inheritance-check): Simplify.
|
||||
|
||||
2015-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/core-elisp-tests.el (core-elisp-tests-3-backquote): New test.
|
||||
|
|
|
|||
|
|
@ -537,9 +537,8 @@ METHOD is the method that was attempting to be called."
|
|||
(should (object-of-class-p eitest-ab 'class-b))
|
||||
(should (object-of-class-p eitest-ab 'class-ab))
|
||||
(should (eq (eieio-class-parents 'class-a) nil))
|
||||
;; FIXME: eieio-class-parents now returns class objects!
|
||||
(should (equal (mapcar #'eieio-class-object (eieio-class-parents 'class-ab))
|
||||
(mapcar #'eieio-class-object '(class-a class-b))))
|
||||
(should (equal (eieio-class-parents 'class-ab)
|
||||
(mapcar #'find-class '(class-a class-b))))
|
||||
(should (same-class-p eitest-a 'class-a))
|
||||
(should (class-a-p eitest-a))
|
||||
(should (not (class-a-p eitest-ab)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue