Commit 94250173 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/emacs-lisp/eieio-base.el: Use lexical-binding and cl-lib.

* lisp/emacs-lisp/eieio-core.el: Use lexical-binding and cl-lib.
(list-of): New type.
(eieio--typep): Remove.
(eieio-perform-slot-validation): Use cl-typep instead.
* lisp/emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback.
(defclass, defgeneric, defmethod): Add doc-string position.
(with-slots): Require cl-lib.
* lisp/emacs-lisp/cl-macs.el (cl--make-type-test): Avoid ((lambda ..) ..).
parent 60727a54
2014-10-17 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback.
(defclass, defgeneric, defmethod): Add doc-string position.
(with-slots): Require cl-lib.
* emacs-lisp/eieio-core.el: Use lexical-binding and cl-lib.
(list-of): New type.
(eieio--typep): Remove.
(eieio-perform-slot-validation): Use cl-typep instead.
* emacs-lisp/eieio-base.el: Use lexical-binding and cl-lib.
* emacs-lisp/cl-macs.el (cl--make-type-test): Avoid ((lambda ..) ..).
2014-10-16 Alan Mackenzie <acm@muc.de>
 
Trigger showing when point is in the "periphery" of a line or just
inside a paren.
* paren.el (show-paren-style, show-paren-delay)
(show-paren-priority, show-paren-ring-bell-on-mismatch): Remove
superfluous :group specifications.
(show-paren-priority, show-paren-ring-bell-on-mismatch):
Remove superfluous :group specifications.
(show-paren-when-point-inside-paren)
(show-paren-when-point-in-periphery): New customizable variables.
(show-paren-highlight-openparen): Make into a defcustom.
......@@ -532,7 +547,7 @@
* term.el (term-mouse-paste):
* mouse.el (mouse-yank-primary): Use gui-get-primary-selection.
 
2014-10-02 H. Dieter Wilhelm <dieter@duenenhof-wilhelm.de> (tiny change)
2014-10-02 H. Dieter Wilhelm <dieter@duenenhof-wilhelm.de>
 
* calc/calc-help.el (calc-describe-thing): Quote strings
which could look like regexps.
......
......@@ -822,7 +822,8 @@ For more details, see Info node `(cl)Loop Facility'.
"repeat" "while" "until" "always" "never"
"thereis" "collect" "append" "nconc" "sum"
"count" "maximize" "minimize" "if" "unless"
"return"] form]
"return"]
form]
;; Simple default, which covers 99% of the cases.
symbolp form)))
(if (not (memq t (mapcar #'symbolp
......@@ -1136,7 +1137,8 @@ For more details, see Info node `(cl)Loop Facility'.
(if end
(push (list
(if down (if excl '> '>=) (if excl '< '<=))
var (or end-var end)) cl--loop-body))
var (or end-var end))
cl--loop-body))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
......@@ -1194,7 +1196,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
(push `(< (setq ,temp-idx (1+ ,temp-idx))
(length ,temp-vec)) cl--loop-body)
(length ,temp-vec))
cl--loop-body)
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
......@@ -1370,7 +1373,8 @@ For more details, see Info node `(cl)Loop Facility'.
(if loop-for-sets
(push `(progn
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
t) cl--loop-body))
t)
cl--loop-body))
(if loop-for-steps
(push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
......@@ -1388,7 +1392,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push `(progn (push ,what ,var) t) cl--loop-body)
(push `(progn
(setq ,var (nconc ,var (list ,what)))
t) cl--loop-body))))
t)
cl--loop-body))))
((memq word '(nconc nconcing append appending))
(let ((what (pop cl--loop-args))
......@@ -1403,7 +1408,9 @@ For more details, see Info node `(cl)Loop Facility'.
,var)
`(,(if (memq word '(nconc nconcing))
#'nconc #'append)
,var ,what))) t) cl--loop-body)))
,var ,what)))
t)
cl--loop-body)))
((memq word '(concat concating))
(let ((what (pop cl--loop-args))
......@@ -1434,7 +1441,8 @@ For more details, see Info node `(cl)Loop Facility'.
(set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
(push `(progn ,(if (eq temp what) set
`(let ((,temp ,what)) ,set))
t) cl--loop-body)))
t)
cl--loop-body)))
((eq word 'with)
(let ((bindings nil))
......@@ -1505,7 +1513,8 @@ For more details, see Info node `(cl)Loop Facility'.
(or cl--loop-result-var
(setq cl--loop-result-var (make-symbol "--cl-var--")))
(push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
,cl--loop-finish-flag nil) cl--loop-body))
,cl--loop-finish-flag nil)
cl--loop-body))
(t
;; This is an advertised interface: (info "(cl)Other Clauses").
......@@ -2398,7 +2407,8 @@ non-nil value, that slot cannot be set via `setf'.
pred-form pred-check)
(if (stringp (car descs))
(push `(put ',name 'structure-documentation
,(pop descs)) forms))
,(pop descs))
forms))
(setq descs (cons '(cl-tag-slot)
(mapcar (function (lambda (x) (if (consp x) x (list x))))
descs)))
......@@ -2551,7 +2561,8 @@ non-nil value, that slot cannot be set via `setf'.
(progn (push `(cl-defsubst ,predicate (cl-x)
,(if (eq (car pred-form) 'and)
(append pred-form '(t))
`(and ,pred-form t))) forms)
`(and ,pred-form t)))
forms)
(push (cons predicate 'error-free) side-eff)))
(and copier
(progn (push `(defun ,copier (x) (copy-sequence x)) forms)
......@@ -2568,7 +2579,8 @@ non-nil value, that slot cannot be set via `setf'.
slots defaults)))
(push `(cl-defsubst ,name
(&cl-defs '(nil ,@descs) ,@args)
(,type ,@make)) forms)
(,type ,@make))
forms)
(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
(push (cons name t) side-eff))))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
......@@ -2673,7 +2685,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
(cdr type))))
((memq (car type) '(member cl-member))
`(and (cl-member ,val ',(cdr type)) t))
((eq (car type) 'satisfies) (list (cadr type) val))
((eq (car type) 'satisfies) `(funcall #',(cadr type) ,val))
(t (error "Bad type spec: %s" type)))))
(defvar cl--object)
......
;;; eieio-base.el --- Base classes for EIEIO.
;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
;;; Copyright (C) 2000-2002, 2004-2005, 2007-2014 Free Software
;;; Foundation, Inc.
......@@ -31,7 +31,7 @@
;;; Code:
(require 'eieio)
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
(eval-when-compile (require 'cl-lib))
;;; eieio-instance-inheritor
;;
......@@ -52,7 +52,8 @@ a parent instance. When a slot in the child is referenced, and has
not been set, use values from the parent."
:abstract t)
(defmethod slot-unbound ((object eieio-instance-inheritor) class slot-name fn)
(defmethod slot-unbound ((object eieio-instance-inheritor)
_class slot-name _fn)
"If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal.
SLOT-NAME is the offending slot. FN is the function signaling the error."
(if (slot-boundp object 'parent-instance)
......@@ -118,7 +119,7 @@ a variable symbol used to store a list of all instances."
:abstract t)
(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
&rest slots)
&rest _slots)
"Make sure THIS is in our master list of this class.
Optional argument SLOTS are the initialization arguments."
;; Theoretically, this is never called twice for a given instance.
......@@ -154,7 +155,7 @@ Multiple calls to `make-instance' will return this object."))
A singleton is a class which will only ever have one instance."
:abstract t)
(defmethod constructor :STATIC ((class eieio-singleton) name &rest slots)
(defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots)
"Constructor for singleton CLASS.
NAME and SLOTS initialize the new object.
This constructor guarantees that no matter how many you request,
......
;;; eieio-core.el --- Core implementation for eieio
;;; eieio-core.el --- Core implementation for eieio -*- lexical-binding:t -*-
;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc.
......@@ -31,7 +31,7 @@
;;; Code:
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
(require 'cl-lib)
;; Compatibility
(if (fboundp 'compiled-function-arglist)
......@@ -408,6 +408,12 @@ It creates an autoload function for CNAME's constructor."
(when (eq (car-safe (symbol-function cname)) 'autoload)
(load-library (car (cdr (symbol-function cname))))))
(cl-deftype list-of (elem-type)
`(and list
(satisfies (lambda (list)
(cl-every (lambda (elem) (cl-typep elem ',elem-type))
list)))))
(defun eieio-defclass (cname superclasses slots options-and-doc)
;; FIXME: Most of this should be moved to the `defclass' macro.
"Define CNAME as a new subclass of SUPERCLASSES.
......@@ -476,7 +482,7 @@ See `defclass' for more information."
(setf (eieio--class-children (class-v (car pname)))
(cons cname (eieio--class-children (class-v (car pname))))))
;; Get custom groups, and store them into our local copy.
(mapc (lambda (g) (pushnew g groups :test #'equal))
(mapc (lambda (g) (cl-pushnew g groups :test #'equal))
(class-option (car pname) :custom-groups))
;; save parent in child
(setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc))))
......@@ -553,8 +559,7 @@ See `defclass' for more information."
;; test, so we can let typep have the CLOS documented behavior
;; while keeping our above predicate clean.
;; It would be cleaner to use `defsetf' here, but that requires cl
;; at runtime.
;; FIXME: It would be cleaner to use `cl-deftype' here.
(put cname 'cl-deftype-handler
(list 'lambda () `(list 'satisfies (quote ,csym)))))
......@@ -655,7 +660,7 @@ See `defclass' for more information."
prot initarg alloc 'defaultoverride skip-nil)
;; We need to id the group, and store them in a group list attribute.
(mapc (lambda (cg) (pushnew cg groups :test 'equal)) customg)
(mapc (lambda (cg) (cl-pushnew cg groups :test 'equal)) customg)
;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
......@@ -721,7 +726,7 @@ See `defclass' for more information."
(setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc)))
(setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc)))
(setf (eieio--class-public-type newc)
(apply 'vector (nreverse (eieio--class-public-type newc))))
(apply #'vector (nreverse (eieio--class-public-type newc))))
(setf (eieio--class-public-custom newc) (nreverse (eieio--class-public-custom newc)))
(setf (eieio--class-public-custom-label newc) (nreverse (eieio--class-public-custom-label newc)))
(setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group newc)))
......@@ -732,11 +737,11 @@ See `defclass' for more information."
;; The storage for class-class-allocation-type needs to be turned into
;; a vector now.
(setf (eieio--class-class-allocation-type newc)
(apply 'vector (eieio--class-class-allocation-type newc)))
(apply #'vector (eieio--class-class-allocation-type newc)))
;; Also, take class allocated values, and vectorize them for speed.
(setf (eieio--class-class-allocation-values newc)
(apply 'vector (eieio--class-class-allocation-values newc)))
(apply #'vector (eieio--class-class-allocation-values newc)))
;; Attach slot symbols into an obarray, and store the index of
;; this slot as the variable slot in this new symbol. We need to
......@@ -779,7 +784,7 @@ See `defclass' for more information."
(fset cname
`(lambda (newname &rest slots)
,(format "Create a new object with name NAME of class type %s" cname)
(apply 'constructor ,cname newname slots)))
(apply #'constructor ,cname newname slots)))
)
;; Set up a specialized doc string.
......@@ -798,7 +803,7 @@ See `defclass' for more information."
;; We have a list of custom groups. Store them into the options.
(let ((g (class-option-assoc options :custom-groups)))
(mapc (lambda (cg) (pushnew cg g :test 'equal)) groups)
(mapc (lambda (cg) (cl-pushnew cg g :test 'equal)) groups)
(if (memq :custom-groups options)
(setcar (cdr (memq :custom-groups options)) g)
(setq options (cons :custom-groups (cons g options)))))
......@@ -1065,7 +1070,7 @@ if default value is nil."
))
))
(defun eieio-copy-parents-into-subclass (newc parents)
(defun eieio-copy-parents-into-subclass (newc _parents)
"Copy into NEWC the slots of PARENTS.
Follow the rules of not overwriting early parents when applying to
the new child class."
......@@ -1178,6 +1183,8 @@ DOC-STRING is the documentation attached to METHOD."
(let ((doc-string (documentation method)))
(fset method (eieio-defgeneric-form-primary-only method doc-string))))
(declare-function no-applicable-method "eieio" (object method &rest args))
(defun eieio-defgeneric-form-primary-only-one (method doc-string
class
impl
......@@ -1212,7 +1219,7 @@ IMPL is the symbol holding the method implementation."
',class)))
;; If not the right kind of object, call no applicable
(apply 'no-applicable-method (car local-args)
(apply #'no-applicable-method (car local-args)
',method local-args)
;; It is ok, do the call.
......@@ -1299,53 +1306,12 @@ but remove reference to all implementations of METHOD."
;; This is a hideous hack for replacing `typep' from cl-macs, to avoid
;; requiring the CL library at run-time. It can be eliminated if/when
;; `typep' is merged into Emacs core.
(defun eieio--typep (val type)
(if (symbolp type)
(cond ((get type 'cl-deftype-handler)
(eieio--typep val (funcall (get type 'cl-deftype-handler))))
((eq type t) t)
((eq type 'null) (null val))
((eq type 'atom) (atom val))
((eq type 'float) (and (numberp val) (not (integerp val))))
((eq type 'real) (numberp val))
((eq type 'fixnum) (integerp val))
((memq type '(character string-char)) (characterp val))
(t
(let* ((name (symbol-name type))
(namep (intern (concat name "p"))))
(if (fboundp namep)
(funcall `(lambda () (,namep val)))
(funcall `(lambda ()
(,(intern (concat name "-p")) val)))))))
(cond ((get (car type) 'cl-deftype-handler)
(eieio--typep val (apply (get (car type) 'cl-deftype-handler)
(cdr type))))
((memq (car type) '(integer float real number))
(and (eieio--typep val (car type))
(or (memq (cadr type) '(* nil))
(if (consp (cadr type))
(> val (car (cadr type)))
(>= val (cadr type))))
(or (memq (caddr type) '(* nil))
(if (consp (car (cddr type)))
(< val (caar (cddr type)))
(<= val (car (cddr type)))))))
((memq (car type) '(and or not))
(eval (cons (car type)
(mapcar (lambda (x)
`(eieio--typep (quote ,val) (quote ,x)))
(cdr type)))))
((memq (car type) '(member member*))
(memql val (cdr type)))
((eq (car type) 'satisfies)
(funcall `(lambda () (,(cadr type) val))))
(t (error "Bad type spec: %s" type)))))
(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
(eieio--typep value spec)))
(cl-typep value spec)))
(defun eieio-validate-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
......@@ -1632,7 +1598,7 @@ If a consistent order does not exist, signal an error."
;; applicable.
(eieio-c3-merge-lists
(cons next reversed-partial-result)
(mapcar (lambda (l) (if (eq (first l) next) (rest l) l))
(mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l))
remaining-inputs))
;; The graph is inconsistent, give up
(signal 'inconsistent-class-hierarchy (list remaining-inputs))))))
......@@ -1700,7 +1666,7 @@ The order, in which the parents are returned depends on the
method invocation orders of the involved classes."
(if (or (null class) (eq class 'eieio-default-superclass))
nil
(case (class-method-invocation-order class)
(cl-case (class-method-invocation-order class)
(:depth-first
(eieio-class-precedence-dfs class))
(:breadth-first
......@@ -1839,7 +1805,7 @@ This should only be called from a generic function."
;; Now loop through all occurrences forms which we must execute
;; (which are happily sorted now) and execute them all!
(let ((rval nil) (lastval nil) (rvalever nil) (found nil))
(let ((rval nil) (lastval nil) (found nil))
(while lambdas
(if (car lambdas)
(eieio--with-scoped-class (cdr (car lambdas))
......@@ -1856,20 +1822,16 @@ This should only be called from a generic function."
;;(setq rval (apply (car (car lambdas)) newargs))
(setq lastval (apply (car (car lambdas)) newargs))
(when has-return-val
(setq rval lastval
rvalever t))
(setq rval lastval))
)))
(setq lambdas (cdr lambdas)
keys (cdr keys)))
(if (not found)
(if (eieio-object-p (car args))
(setq rval (apply 'no-applicable-method (car args) method args)
rvalever t)
(setq rval (apply #'no-applicable-method (car args) method args))
(signal
'no-method-definition
(list method args))))
;; Right Here... it could be that lastval is returned when
;; rvalever is nil. Is that right?
rval)))
(defun eieio-generic-call-primary-only (method args)
......@@ -1920,7 +1882,7 @@ for this common case to improve performance."
;; Now loop through all occurrences forms which we must execute
;; (which are happily sorted now) and execute them all!
(eieio--with-scoped-class (cdr lambdas)
(let* ((rval nil) (lastval nil) (rvalever nil)
(let* ((rval nil) (lastval nil)
(eieio-generic-call-key method-primary)
;; Use the cdr, as the first element is the fcn
;; we are calling right now.
......@@ -1931,8 +1893,8 @@ for this common case to improve performance."
;; No methods found for this impl...
(if (eieio-object-p (car args))
(setq rval (apply 'no-applicable-method (car args) method args)
rvalever t)
(setq rval (apply #'no-applicable-method
(car args) method args))
(signal
'no-method-definition
(list method args)))
......@@ -1943,12 +1905,8 @@ for this common case to improve performance."
lambdas)
(setq lastval (apply (car lambdas) newargs))
(setq rval lastval
rvalever t)
)
(setq rval lastval))
;; Right Here... it could be that lastval is returned when
;; rvalever is nil. Is that right?
rval))))
(defun eieiomt-method-list (method key class)
......@@ -2054,7 +2012,7 @@ CLASS is the class this method is associated with."
(when (string-match "\\.elc$" fname)
(setq fname (substring fname 0 (1- (length fname)))))
(setq loc (get method-name 'method-locations))
(pushnew (list class fname) loc :test 'equal)
(cl-pushnew (list class fname) loc :test 'equal)
(put method-name 'method-locations loc)))
;; Now optimize the entire obarray
(if (< key method-num-lists)
......@@ -2084,7 +2042,8 @@ nil for superclasses. This function performs no type checking!"
;; we replace the nil from above.
(let ((external-symbol (intern-soft (symbol-name s))))
(catch 'done
(dolist (ancestor (rest (eieio-class-precedence-list external-symbol)))
(dolist (ancestor
(cl-rest (eieio-class-precedence-list external-symbol)))
(let ((ov (intern-soft (symbol-name ancestor)
eieiomt-optimizing-obarray)))
(when (fboundp ov)
......
;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*-
;;; or maybe Eric's Implementation of Emacs Interpreted Objects
;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc.
......@@ -44,8 +44,6 @@
;;; Code:
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
(defvar eieio-version "1.4"
"Current version of EIEIO.")
......@@ -115,6 +113,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))
;; This is eval-and-compile only to silence spurious compiler warnings
;; about functions and variables not known to be defined.
;; When eieio-defclass code is merged here and this becomes
......@@ -155,7 +154,7 @@ a string."
;;; CLOS methods and generics
;;
(defmacro defgeneric (method args &optional doc-string)
(defmacro defgeneric (method _args &optional doc-string)
"Create a generic function METHOD.
DOC-STRING is the base documentation for this class. A generic
function has no body, as its purpose is to decide which method body
......@@ -163,6 +162,7 @@ is appropriate to use. Uses `defmethod' to create methods, and calls
`defgeneric' for you. With this implementation the ARGS are
currently ignored. You can use `defgeneric' to apply specialized
top level documentation to a method."
(declare (doc-string 3))
`(eieio--defalias ',method
(eieio--defgeneric-init-form ',method ,doc-string)))
......@@ -191,6 +191,7 @@ Summary:
((typearg class-name) arg2 &optional opt &rest rest)
\"doc-string\"
body)"
(declare (doc-string 3))
(let* ((key (if (keywordp (car args)) (pop args)))
(params (car args))
(arg1 (car params))
......@@ -246,6 +247,7 @@ 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))
(require 'cl-lib)
;; Transform the spec-list into a cl-symbol-macrolet spec-list.
(let ((mappings (mapcar (lambda (entry)
(let ((var (if (listp entry) (car entry) entry))
......@@ -523,7 +525,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 (or (not next) (not (car next)))
(apply 'no-next-method (car newargs) (cdr newargs))
(apply #'no-next-method (car newargs) (cdr newargs))
(let* ((eieio-generic-call-next-method-list
(cdr eieio-generic-call-next-method-list))
(eieio-generic-call-arglst newargs)
......@@ -535,27 +537,7 @@ Use `next-method-p' to find out if there is a next method to call."
;;; Here are some CLOS items that need the CL package
;;
(defsetf eieio-oref eieio-oset)
(if (eval-when-compile (fboundp 'gv-define-expander))
;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
;; follows aliases.
nil
(defsetf slot-value eieio-oset)
;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
(define-setf-method oref (obj slot)
(with-no-warnings
(require 'cl)
(let ((obj-temp (gensym))
(slot-temp (gensym))
(store-temp (gensym)))
(list (list obj-temp slot-temp)
(list obj `(quote ,slot))
(list store-temp)
(list 'set-slot-value obj-temp slot-temp
store-temp)
(list 'slot-value obj-temp slot-temp))))))
(gv-define-simple-setter eieio-oref eieio-oset)
;;;
......@@ -651,7 +633,7 @@ dynamically set from SLOTS."
"Method invoked when an attempt to access a slot in OBJECT fails.")
(defmethod slot-missing ((object eieio-default-superclass) slot-name
operation &optional new-value)
_operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.
SLOT-NAME is the name of the failed slot, OPERATION is the type of access
that was requested, and optional NEW-VALUE is the value that was desired
......@@ -684,7 +666,7 @@ EIEIO can only dispatch on the first argument, so the first two are swapped."
"Called if there are no implementations for OBJECT in METHOD.")
(defmethod no-applicable-method ((object eieio-default-superclass)
method &rest args)
method &rest _args)
"Called if there are no implementations for OBJECT in METHOD.
OBJECT is the object which has no method implementation.
ARGS are the arguments that were passed to METHOD.
......@@ -734,7 +716,7 @@ first and modify the returned object.")
(defgeneric destructor (this &rest params)
"Destructor for cleaning up any dynamic links to our object.")
(defmethod destructor ((this eieio-default-superclass) &rest params)
(defmethod destructor ((_this eieio-default-superclass) &rest _params)
"Destructor for cleaning up any dynamic links to our object.
Argument THIS is the object being destroyed. PARAMS are additional
ignored parameters."
......@@ -760,7 +742,7 @@ Implement this function and specify STRINGS in a call to
`call-next-method' to provide additional summary information.
When passing in extra strings from child classes, always remember
to prepend a space."
(eieio-object-name this (apply 'concat strings)))
(eieio-object-name this (apply #'concat strings)))
(defvar eieio-print-depth 0
"When printing, keep track of the current indentation depth.")
......@@ -859,7 +841,7 @@ this object."
;;; Unimplemented functions from CLOS
;;
(defun change-class (obj class)
(defun change-class (_obj _class)
"Change the class of OBJ to type CLASS.
This may create or delete slots, but does not affect the return value
of `eq'."
......@@ -879,7 +861,8 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
((eieio-object-p object) (object-print object))
((and (listp object) (or (class-p (car object))
(eieio-object-p (car object))))
(concat "(" (mapconcat 'eieio-edebug-prin1-to-string object " ") ")"))
(concat "(" (mapconcat #'eieio-edebug-prin1-to-string object " ")
")"))
(t (prin1-to-string object noescape))))
(add-hook 'edebug-setup-hook
......
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