* 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 ..) ..).
+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.
* 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.
"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
(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)))
(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)
(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)))
(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))
,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))
(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))
(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").
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)))
(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)
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)))
(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.
;;; Code:
(require 'eieio)
-(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
+(eval-when-compile (require 'cl-lib))
;;; eieio-instance-inheritor
;;
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)
: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.
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.
;;; Code:
-(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
+(require 'cl-lib)
;; Compatibility
(if (fboundp 'compiled-function-arglist)
(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.
(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))))
;; 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)))))
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
(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)))
;; 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
(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.
;; 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)))))
))
))
-(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."
(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
',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.
;; 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.
;; 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))))))
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
;; 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))
;;(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)
;; 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.
;; 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)))
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)
(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)
;; 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.
;;; Code:
-(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
-
(defvar eieio-version "1.4"
"Current version of 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
\f
;;; 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
`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)))
((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))
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))
(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)
;;; 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)
\f
;;;
"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
"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.
(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."
`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.")
\f
;;; 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'."
((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
projects / emacs.git / commitdiff