From 942501730f55719f1d3cda9f476e00f5c497259c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 17 Oct 2014 01:09:24 -0400 Subject: [PATCH] * 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 ..) ..). --- lisp/ChangeLog | 21 ++++++- lisp/emacs-lisp/cl-macs.el | 36 ++++++++---- lisp/emacs-lisp/eieio-base.el | 11 ++-- lisp/emacs-lisp/eieio-core.el | 107 +++++++++++----------------------- lisp/emacs-lisp/eieio.el | 47 +++++---------- 5 files changed, 96 insertions(+), 126 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b3d8d9a87b..b69ab31db3d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,10 +1,25 @@ +2014-10-17 Stefan Monnier + + * 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 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 (tiny change) +2014-10-02 H. Dieter Wilhelm * calc/calc-help.el (calc-describe-thing): Quote strings which could look like regexps. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index e4a73d1a4de..8336a2443da 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -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) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 150724e6484..a1c2cb54a9e 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -1,4 +1,4 @@ -;;; 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, diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 76655caf65a..4637de5fd3e 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1,4 +1,4 @@ -;;; 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) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 23cf5197233..22e247937e8 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -1,4 +1,4 @@ -;;; 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 -(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 -- 2.39.5