Commit d4a12e7a authored by Stefan Monnier's avatar Stefan Monnier

* lisp/emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v.

(method-*): Add a "eieio--" prefix to those constants.

* lisp/emacs-lisp/eieio-speedbar.el: Use lexical-binding.

* lisp/emacs-lisp/eieio.el: Move edebug specs to the corresponding macro.
parent bcebc831
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v.
(method-*): Add a "eieio--" prefix to those constants.
* emacs-lisp/eieio.el: Move edebug specs to the corresponding macro.
* emacs-lisp/eieio-speedbar.el: Use lexical-binding.
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is
......
......@@ -309,7 +309,7 @@ Second, any text properties will be stripped from strings."
(type nil)
(classtype nil))
(setq slot-idx (- slot-idx 3))
(setq type (aref (eieio--class-public-type (class-v class))
(setq type (aref (eieio--class-public-type (eieio--class-v class))
slot-idx))
(setq classtype (eieio-persistent-slot-type-is-class-p
......
This diff is collapsed.
......@@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter."
(let* ((chil nil)
(obj (widget-get widget :value))
(master-group (widget-get widget :eieio-group))
(cv (class-v (eieio--object-class obj)))
(cv (eieio--class-v (eieio--object-class obj)))
(slots (eieio--class-public-a cv))
(flabel (eieio--class-public-custom-label cv))
(fgroup (eieio--class-public-custom-group cv))
......@@ -288,7 +288,7 @@ Optional argument IGNORE is an extraneous parameter."
"Get the value of WIDGET."
(let* ((obj (widget-get widget :value))
(master-group eieio-cog)
(cv (class-v (eieio--object-class obj)))
(cv (eieio--class-v (eieio--object-class obj)))
(fgroup (eieio--class-public-custom-group cv))
(wids (widget-get widget :children))
(name (if (widget-get widget :eieio-show-name)
......@@ -296,7 +296,7 @@ Optional argument IGNORE is an extraneous parameter."
nil))
(chil (if (widget-get widget :eieio-show-name)
(nthcdr 1 wids) wids))
(cv (class-v (eieio--object-class obj)))
(cv (eieio--class-v (eieio--object-class obj)))
(slots (eieio--class-public-a cv))
(fcust (eieio--class-public-custom cv)))
;; If there are any prefix widgets, clear them.
......@@ -321,7 +321,7 @@ Optional argument IGNORE is an extraneous parameter."
;; This is the same object we had before.
obj))
(defmethod eieio-done-customizing ((obj eieio-default-superclass))
(defmethod eieio-done-customizing ((_obj eieio-default-superclass))
"When applying change to a widget, call this method.
This method is called by the default widget-edit commands.
User made commands should also call this method when applying changes.
......@@ -385,7 +385,7 @@ These groups are specified with the `:group' slot flag."
(make-local-variable 'eieio-cog)
(setq eieio-cog g)))
(defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass))
(defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
"Insert an Apply and Reset button into the object editor.
Argument OBJ is the object being customized."
(widget-create 'push-button
......
......@@ -87,7 +87,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
prefix
"Name: ")
(let* ((cl (eieio-object-class obj))
(cv (class-v cl)))
(cv (eieio--class-v cl)))
(data-debug-insert-thing (class-constructor cl)
prefix
"Class: ")
......
......@@ -60,7 +60,7 @@ Argument PREFIX is the character prefix to use.
Argument CH-PREFIX is another character prefix to display."
(eieio--check-type class-p this-root)
(let ((myname (symbol-name this-root))
(chl (eieio--class-children (class-v this-root)))
(chl (eieio--class-children (eieio--class-v this-root)))
(fprefix (concat ch-prefix " +--"))
(mprefix (concat ch-prefix " | "))
(lprefix (concat ch-prefix " ")))
......@@ -149,7 +149,7 @@ If CLASS is actually an object, then also display current values of that object.
(defun eieio-help-class-slots (class)
"Print help description for the slots in CLASS.
Outputs to the current buffer."
(let* ((cv (class-v class))
(let* ((cv (eieio--class-v class))
(docs (eieio--class-public-doc cv))
(names (eieio--class-public-a cv))
(deflt (eieio--class-public-d cv))
......@@ -231,7 +231,7 @@ If INSTANTIABLE-ONLY is non nil, only allow names of classes which
are not abstract, otherwise allow all classes.
Optional argument BUILDLIST is more list to attach and is used internally."
(let* ((cc (or class eieio-default-superclass))
(sublst (eieio--class-children (class-v cc))))
(sublst (eieio--class-children (eieio--class-v cc))))
(unless (assoc (symbol-name cc) buildlist)
(when (or (not instantiable-only) (not (class-abstract-p cc)))
;; FIXME: Completion tables don't need alists, and ede/generic.el needs
......@@ -637,7 +637,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)
(let ((subclasses (eieio--class-children (class-v class))))
(let ((subclasses (eieio--class-children (eieio--class-v class))))
(if subclasses
(speedbar-make-tag-line 'angle ?+
'eieio-sb-expand
......@@ -662,7 +662,7 @@ Argument INDENT is the depth of indentation."
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(let ((subclasses (eieio--class-children (class-v class))))
(let ((subclasses (eieio--class-children (eieio--class-v class))))
(while subclasses
(eieio-class-button (car subclasses) (1+ indent))
(setq subclasses (cdr subclasses)))))))
......
;;; eieio-speedbar.el -- Classes for managing speedbar displays.
;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*-
;; Copyright (C) 1999-2002, 2005, 2007-2014 Free Software Foundation,
;; Inc.
......@@ -200,7 +200,7 @@ that path."
"Return a string describing OBJECT."
(eieio-object-name-string object))
(defmethod eieio-speedbar-derive-line-path (object)
(defmethod eieio-speedbar-derive-line-path (_object)
"Return the path which OBJECT has something to do with."
nil)
......@@ -321,7 +321,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
(if exp
(eieio-speedbar-expand object (1+ depth))))))
(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth)
(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
"Base method for creating tag lines for non-object children."
(error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
(eieio-object-name object)))
......@@ -340,7 +340,7 @@ OBJECT."
;;; Speedbar specific function callbacks.
;;
(defun eieio-speedbar-object-click (text token indent)
(defun eieio-speedbar-object-click (_text token _indent)
"Handle a user click on TEXT representing object TOKEN.
The object is at indentation level INDENT."
(eieio-speedbar-handle-click token))
......@@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at."
;;; Methods to the eieio-speedbar-* classes which need to be overridden.
;;
(defmethod eieio-speedbar-object-children ((object eieio-speedbar))
(defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
"Return a list of children to be displayed in speedbar.
If the return value is a list of OBJECTs, then those objects are
queried for details. If the return list is made of strings,
......
......@@ -191,7 +191,16 @@ Summary:
((typearg class-name) arg2 &optional opt &rest rest)
\"doc-string\"
body)"
(declare (doc-string 3))
(declare (doc-string 3)
(debug
(&define ; this means we are defining something
[&or name ("setf" :name setf name)]
;; ^^ This is the methods symbol
[ &optional symbolp ] ; this is key :before etc
list ; arguments
[ &optional stringp ] ; documentation string
def-body ; part to be debugged
)))
(let* ((key (if (keywordp (car args)) (pop args)))
(params (car args))
(arg1 (car params))
......@@ -213,6 +222,7 @@ Summary:
"Retrieve the value stored in OBJ in the slot named by SLOT.
Slot is the name of the slot when created by `defclass' or the label
created by the :initarg tag."
(declare (debug (form symbolp)))
`(eieio-oref ,obj (quote ,slot)))
(defalias 'slot-value 'eieio-oref)
......@@ -223,6 +233,7 @@ created by the :initarg tag."
The default value is the value installed in a class with the :initform
tag. SLOT can be the slot name, or the tag specified by the :initarg
tag in the `defclass' call."
(declare (debug (form symbolp)))
`(eieio-oref-default ,obj (quote ,slot)))
;;; Handy CLOS macros
......@@ -246,7 +257,7 @@ SPEC-LIST is of a form similar to `let'. For example:
Where each VAR is the local variable given to the associated
SLOT. A slot specified without a variable name is given a
variable name of the same name as the slot."
(declare (indent 2))
(declare (indent 2) (debug (sexp sexp def-body)))
(require 'cl-lib)
;; Transform the spec-list into a cl-symbol-macrolet spec-list.
(let ((mappings (mapcar (lambda (entry)
......@@ -348,7 +359,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
(or (eq class 'eieio-default-superclass)
(let ((p nil))
(while (and child (not (eq child class)))
(setq p (append p (eieio--class-parent (class-v child)))
(setq p (append p (eieio--class-parent (eieio--class-v child)))
child (car p)
p (cdr p)))
(if child t))))
......@@ -356,11 +367,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)
(eieio--class-public-a (class-v (eieio--object-class obj))))
(eieio--class-public-a (eieio--class-v (eieio--object-class obj))))
(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
(eieio--check-type class-p class)
(let ((ia (eieio--class-initarg-tuples (class-v class)))
(let ((ia (eieio--class-initarg-tuples (eieio--class-v class)))
(f nil))
(while (and ia (not f))
(if (eq (cdr (car ia)) slot)
......@@ -374,6 +385,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
"Set the value in OBJ for slot SLOT to VALUE.
SLOT is the slot name as specified in `defclass' or the tag created
with in the :initarg slot. VALUE can be any Lisp object."
(declare (debug (form symbolp form)))
`(eieio-oset ,obj (quote ,slot) ,value))
(defmacro oset-default (class slot value)
......@@ -381,6 +393,7 @@ with in the :initarg slot. VALUE can be any Lisp object."
The default value is usually set with the :initform tag during class
creation. This allows users to change the default behavior of classes
after they are created."
(declare (debug (form symbolp form)))
`(eieio-oset-default ,class (quote ,slot) ,value))
;;; CLOS queries into classes and slots
......@@ -405,7 +418,7 @@ OBJECT can be an instance or a class."
(defun slot-exists-p (object-or-class slot)
"Return non-nil if OBJECT-OR-CLASS has SLOT."
(let ((cv (class-v (cond ((eieio-object-p object-or-class)
(let ((cv (eieio--class-v (cond ((eieio-object-p object-or-class)
(eieio-object-class object-or-class))
((class-p object-or-class)
object-or-class))
......@@ -421,7 +434,7 @@ 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)
(class-v symbol)))
(eieio--class-v symbol)))
;;; Slightly more complex utility functions for objects
;;
......@@ -520,8 +533,8 @@ arguments passed in at the top level.
Use `next-method-p' to find out if there is a next method to call."
(if (not (eieio--scoped-class))
(error "`call-next-method' not called within a class specific method"))
(if (and (/= eieio-generic-call-key method-primary)
(/= eieio-generic-call-key method-static))
(if (and (/= eieio-generic-call-key eieio--method-primary)
(/= eieio-generic-call-key eieio--method-static))
(error "Cannot `call-next-method' except in :primary or :static methods")
)
(let ((newargs (or replacement-args eieio-generic-call-arglst))
......@@ -572,7 +585,7 @@ SLOTS are the initialization slots used by `shared-initialize'.
This static method is called when an object is constructed.
It allocates the vector used to represent an EIEIO object, and then
calls `shared-initialize' on that object."
(let* ((new-object (copy-sequence (eieio--class-default-object-cache (class-v class)))))
(let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class)))))
;; Update the name for the newly created object.
(setf (eieio--object-name new-object) newname)
;; Call the initialize method on the new object with the slots
......@@ -612,7 +625,7 @@ not taken, then new objects of your class will not have their values
dynamically set from SLOTS."
;; First, see if any of our defaults are `lambda', and
;; re-evaluate them and apply the value to our slots.
(let* ((this-class (class-v (eieio--object-class this)))
(let* ((this-class (eieio--class-v (eieio--object-class this)))
(slot (eieio--class-public-a this-class))
(defaults (eieio--class-public-d this-class)))
(while slot
......@@ -767,7 +780,7 @@ this object."
(princ comment)
(princ "\n"))
(let* ((cl (eieio-object-class this))
(cv (class-v cl)))
(cv (eieio--class-v cl)))
;; Now output readable lisp to recreate this object
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
......@@ -870,35 +883,13 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
")"))
(t (funcall print-function object noescape))))
(add-hook 'edebug-setup-hook
(lambda ()
(def-edebug-spec defmethod
(&define ; this means we are defining something
[&or name ("setf" :name setf name)]
;; ^^ This is the methods symbol
[ &optional symbolp ] ; this is key :before etc
list ; arguments
[ &optional stringp ] ; documentation string
def-body ; part to be debugged
))
;; The rest of the macros
(def-edebug-spec oref (form quote))
(def-edebug-spec oref-default (form quote))
(def-edebug-spec oset (form quote form))
(def-edebug-spec oset-default (form quote form))
(def-edebug-spec class-v form)
(def-edebug-spec class-p form)
(def-edebug-spec eieio-object-p form)
(def-edebug-spec class-constructor form)
(def-edebug-spec generic-p form)
(def-edebug-spec with-slots (list list def-body))
(advice-add 'edebug-prin1-to-string
:around #'eieio-edebug-prin1-to-string)))
(advice-add 'edebug-prin1-to-string
:around #'eieio-edebug-prin1-to-string)
;;; Start of automatically extracted autoloads.
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "ab711689b2bae8a7d8c4b1e99c892306")
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6413249ec10091eb7094238637b40e2c")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
......@@ -909,7 +900,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;***
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "e50a67ebd0c6258c615e4bf16714e81f")
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6f114a48de40212413d2776eedc3ec14")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
......
......@@ -40,7 +40,7 @@
(let* ((file (oref original :file))
(class (eieio-object-class original))
(fromdisk (eieio-persistent-read file class))
(cv (class-v class))
(cv (eieio--class-v class))
(slot-names (eieio--class-public-a cv))
(slot-deflt (eieio--class-public-d cv))
)
......
......@@ -794,7 +794,7 @@ Subclasses to override slot attributes.")
(should (eq (oref-default slotattr-class-ok initform) 'no-init)))
(ert-deftest eieio-test-32-slot-attribute-override-2 ()
(let* ((cv (class-v 'slotattr-ok))
(let* ((cv (eieio--class-v 'slotattr-ok))
(docs (eieio--class-public-doc cv))
(names (eieio--class-public-a cv))
(cust (eieio--class-public-custom cv))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment