* 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 ..) ..).
This commit is contained in:
parent
60727a5494
commit
942501730f
5 changed files with 96 additions and 126 deletions
|
@ -1,10 +1,25 @@
|
||||||
|
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>
|
2014-10-16 Alan Mackenzie <acm@muc.de>
|
||||||
|
|
||||||
Trigger showing when point is in the "periphery" of a line or just
|
Trigger showing when point is in the "periphery" of a line or just
|
||||||
inside a paren.
|
inside a paren.
|
||||||
* paren.el (show-paren-style, show-paren-delay)
|
* paren.el (show-paren-style, show-paren-delay)
|
||||||
(show-paren-priority, show-paren-ring-bell-on-mismatch): Remove
|
(show-paren-priority, show-paren-ring-bell-on-mismatch):
|
||||||
superfluous :group specifications.
|
Remove superfluous :group specifications.
|
||||||
(show-paren-when-point-inside-paren)
|
(show-paren-when-point-inside-paren)
|
||||||
(show-paren-when-point-in-periphery): New customizable variables.
|
(show-paren-when-point-in-periphery): New customizable variables.
|
||||||
(show-paren-highlight-openparen): Make into a defcustom.
|
(show-paren-highlight-openparen): Make into a defcustom.
|
||||||
|
@ -532,7 +547,7 @@
|
||||||
* term.el (term-mouse-paste):
|
* term.el (term-mouse-paste):
|
||||||
* mouse.el (mouse-yank-primary): Use gui-get-primary-selection.
|
* 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
|
* calc/calc-help.el (calc-describe-thing): Quote strings
|
||||||
which could look like regexps.
|
which could look like regexps.
|
||||||
|
|
|
@ -822,7 +822,8 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||||
"repeat" "while" "until" "always" "never"
|
"repeat" "while" "until" "always" "never"
|
||||||
"thereis" "collect" "append" "nconc" "sum"
|
"thereis" "collect" "append" "nconc" "sum"
|
||||||
"count" "maximize" "minimize" "if" "unless"
|
"count" "maximize" "minimize" "if" "unless"
|
||||||
"return"] form]
|
"return"]
|
||||||
|
form]
|
||||||
;; Simple default, which covers 99% of the cases.
|
;; Simple default, which covers 99% of the cases.
|
||||||
symbolp form)))
|
symbolp form)))
|
||||||
(if (not (memq t (mapcar #'symbolp
|
(if (not (memq t (mapcar #'symbolp
|
||||||
|
@ -1136,7 +1137,8 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||||
(if end
|
(if end
|
||||||
(push (list
|
(push (list
|
||||||
(if down (if excl '> '>=) (if excl '< '<=))
|
(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
|
(push (list var (list (if down '- '+) var
|
||||||
(or step-var step 1)))
|
(or step-var step 1)))
|
||||||
loop-for-steps)))
|
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-vec (pop cl--loop-args)) loop-for-bindings)
|
||||||
(push (list temp-idx -1) loop-for-bindings)
|
(push (list temp-idx -1) loop-for-bindings)
|
||||||
(push `(< (setq ,temp-idx (1+ ,temp-idx))
|
(push `(< (setq ,temp-idx (1+ ,temp-idx))
|
||||||
(length ,temp-vec)) cl--loop-body)
|
(length ,temp-vec))
|
||||||
|
cl--loop-body)
|
||||||
(if (eq word 'across-ref)
|
(if (eq word 'across-ref)
|
||||||
(push (list var `(aref ,temp-vec ,temp-idx))
|
(push (list var `(aref ,temp-vec ,temp-idx))
|
||||||
cl--loop-symbol-macs)
|
cl--loop-symbol-macs)
|
||||||
|
@ -1370,7 +1373,8 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||||
(if loop-for-sets
|
(if loop-for-sets
|
||||||
(push `(progn
|
(push `(progn
|
||||||
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
|
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
|
||||||
t) cl--loop-body))
|
t)
|
||||||
|
cl--loop-body))
|
||||||
(if loop-for-steps
|
(if loop-for-steps
|
||||||
(push (cons (if ands 'cl-psetq 'setq)
|
(push (cons (if ands 'cl-psetq 'setq)
|
||||||
(apply 'append (nreverse loop-for-steps)))
|
(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 (push ,what ,var) t) cl--loop-body)
|
||||||
(push `(progn
|
(push `(progn
|
||||||
(setq ,var (nconc ,var (list ,what)))
|
(setq ,var (nconc ,var (list ,what)))
|
||||||
t) cl--loop-body))))
|
t)
|
||||||
|
cl--loop-body))))
|
||||||
|
|
||||||
((memq word '(nconc nconcing append appending))
|
((memq word '(nconc nconcing append appending))
|
||||||
(let ((what (pop cl--loop-args))
|
(let ((what (pop cl--loop-args))
|
||||||
|
@ -1403,7 +1408,9 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||||
,var)
|
,var)
|
||||||
`(,(if (memq word '(nconc nconcing))
|
`(,(if (memq word '(nconc nconcing))
|
||||||
#'nconc #'append)
|
#'nconc #'append)
|
||||||
,var ,what))) t) cl--loop-body)))
|
,var ,what)))
|
||||||
|
t)
|
||||||
|
cl--loop-body)))
|
||||||
|
|
||||||
((memq word '(concat concating))
|
((memq word '(concat concating))
|
||||||
(let ((what (pop cl--loop-args))
|
(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))))
|
(set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
|
||||||
(push `(progn ,(if (eq temp what) set
|
(push `(progn ,(if (eq temp what) set
|
||||||
`(let ((,temp ,what)) ,set))
|
`(let ((,temp ,what)) ,set))
|
||||||
t) cl--loop-body)))
|
t)
|
||||||
|
cl--loop-body)))
|
||||||
|
|
||||||
((eq word 'with)
|
((eq word 'with)
|
||||||
(let ((bindings nil))
|
(let ((bindings nil))
|
||||||
|
@ -1505,7 +1513,8 @@ For more details, see Info node `(cl)Loop Facility'.
|
||||||
(or cl--loop-result-var
|
(or cl--loop-result-var
|
||||||
(setq cl--loop-result-var (make-symbol "--cl-var--")))
|
(setq cl--loop-result-var (make-symbol "--cl-var--")))
|
||||||
(push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
|
(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
|
(t
|
||||||
;; This is an advertised interface: (info "(cl)Other Clauses").
|
;; 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)
|
pred-form pred-check)
|
||||||
(if (stringp (car descs))
|
(if (stringp (car descs))
|
||||||
(push `(put ',name 'structure-documentation
|
(push `(put ',name 'structure-documentation
|
||||||
,(pop descs)) forms))
|
,(pop descs))
|
||||||
|
forms))
|
||||||
(setq descs (cons '(cl-tag-slot)
|
(setq descs (cons '(cl-tag-slot)
|
||||||
(mapcar (function (lambda (x) (if (consp x) x (list x))))
|
(mapcar (function (lambda (x) (if (consp x) x (list x))))
|
||||||
descs)))
|
descs)))
|
||||||
|
@ -2551,7 +2561,8 @@ non-nil value, that slot cannot be set via `setf'.
|
||||||
(progn (push `(cl-defsubst ,predicate (cl-x)
|
(progn (push `(cl-defsubst ,predicate (cl-x)
|
||||||
,(if (eq (car pred-form) 'and)
|
,(if (eq (car pred-form) 'and)
|
||||||
(append pred-form '(t))
|
(append pred-form '(t))
|
||||||
`(and ,pred-form t))) forms)
|
`(and ,pred-form t)))
|
||||||
|
forms)
|
||||||
(push (cons predicate 'error-free) side-eff)))
|
(push (cons predicate 'error-free) side-eff)))
|
||||||
(and copier
|
(and copier
|
||||||
(progn (push `(defun ,copier (x) (copy-sequence x)) forms)
|
(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)))
|
slots defaults)))
|
||||||
(push `(cl-defsubst ,name
|
(push `(cl-defsubst ,name
|
||||||
(&cl-defs '(nil ,@descs) ,@args)
|
(&cl-defs '(nil ,@descs) ,@args)
|
||||||
(,type ,@make)) forms)
|
(,type ,@make))
|
||||||
|
forms)
|
||||||
(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
|
(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
|
||||||
(push (cons name t) side-eff))))
|
(push (cons name t) side-eff))))
|
||||||
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
|
(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))))
|
(cdr type))))
|
||||||
((memq (car type) '(member cl-member))
|
((memq (car type) '(member cl-member))
|
||||||
`(and (cl-member ,val ',(cdr type)) t))
|
`(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)))))
|
(t (error "Bad type spec: %s" type)))))
|
||||||
|
|
||||||
(defvar cl--object)
|
(defvar cl--object)
|
||||||
|
|
|
@ -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
|
;;; Copyright (C) 2000-2002, 2004-2005, 2007-2014 Free Software
|
||||||
;;; Foundation, Inc.
|
;;; Foundation, Inc.
|
||||||
|
@ -31,7 +31,7 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'eieio)
|
(require 'eieio)
|
||||||
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
|
(eval-when-compile (require 'cl-lib))
|
||||||
|
|
||||||
;;; eieio-instance-inheritor
|
;;; 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."
|
not been set, use values from the parent."
|
||||||
:abstract t)
|
: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.
|
"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."
|
SLOT-NAME is the offending slot. FN is the function signaling the error."
|
||||||
(if (slot-boundp object 'parent-instance)
|
(if (slot-boundp object 'parent-instance)
|
||||||
|
@ -118,7 +119,7 @@ a variable symbol used to store a list of all instances."
|
||||||
:abstract t)
|
:abstract t)
|
||||||
|
|
||||||
(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
|
(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
|
||||||
&rest slots)
|
&rest _slots)
|
||||||
"Make sure THIS is in our master list of this class.
|
"Make sure THIS is in our master list of this class.
|
||||||
Optional argument SLOTS are the initialization arguments."
|
Optional argument SLOTS are the initialization arguments."
|
||||||
;; Theoretically, this is never called twice for a given instance.
|
;; 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."
|
A singleton is a class which will only ever have one instance."
|
||||||
:abstract t)
|
:abstract t)
|
||||||
|
|
||||||
(defmethod constructor :STATIC ((class eieio-singleton) name &rest slots)
|
(defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots)
|
||||||
"Constructor for singleton CLASS.
|
"Constructor for singleton CLASS.
|
||||||
NAME and SLOTS initialize the new object.
|
NAME and SLOTS initialize the new object.
|
||||||
This constructor guarantees that no matter how many you request,
|
This constructor guarantees that no matter how many you request,
|
||||||
|
|
|
@ -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.
|
;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
@ -31,7 +31,7 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
|
(require 'cl-lib)
|
||||||
|
|
||||||
;; Compatibility
|
;; Compatibility
|
||||||
(if (fboundp 'compiled-function-arglist)
|
(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)
|
(when (eq (car-safe (symbol-function cname)) 'autoload)
|
||||||
(load-library (car (cdr (symbol-function cname))))))
|
(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)
|
(defun eieio-defclass (cname superclasses slots options-and-doc)
|
||||||
;; FIXME: Most of this should be moved to the `defclass' macro.
|
;; FIXME: Most of this should be moved to the `defclass' macro.
|
||||||
"Define CNAME as a new subclass of SUPERCLASSES.
|
"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)))
|
(setf (eieio--class-children (class-v (car pname)))
|
||||||
(cons cname (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.
|
;; 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))
|
(class-option (car pname) :custom-groups))
|
||||||
;; save parent in child
|
;; save parent in child
|
||||||
(setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc))))
|
(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
|
;; test, so we can let typep have the CLOS documented behavior
|
||||||
;; while keeping our above predicate clean.
|
;; while keeping our above predicate clean.
|
||||||
|
|
||||||
;; It would be cleaner to use `defsetf' here, but that requires cl
|
;; FIXME: It would be cleaner to use `cl-deftype' here.
|
||||||
;; at runtime.
|
|
||||||
(put cname 'cl-deftype-handler
|
(put cname 'cl-deftype-handler
|
||||||
(list 'lambda () `(list 'satisfies (quote ,csym)))))
|
(list 'lambda () `(list 'satisfies (quote ,csym)))))
|
||||||
|
|
||||||
|
@ -655,7 +660,7 @@ See `defclass' for more information."
|
||||||
prot initarg alloc 'defaultoverride skip-nil)
|
prot initarg alloc 'defaultoverride skip-nil)
|
||||||
|
|
||||||
;; We need to id the group, and store them in a group list attribute.
|
;; 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
|
;; Anyone can have an accessor function. This creates a function
|
||||||
;; of the specified name, and also performs a `defsetf' if applicable
|
;; 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-d newc) (nreverse (eieio--class-public-d newc)))
|
||||||
(setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc)))
|
(setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc)))
|
||||||
(setf (eieio--class-public-type 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 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-label newc) (nreverse (eieio--class-public-custom-label newc)))
|
||||||
(setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group 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
|
;; The storage for class-class-allocation-type needs to be turned into
|
||||||
;; a vector now.
|
;; a vector now.
|
||||||
(setf (eieio--class-class-allocation-type newc)
|
(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.
|
;; Also, take class allocated values, and vectorize them for speed.
|
||||||
(setf (eieio--class-class-allocation-values newc)
|
(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
|
;; Attach slot symbols into an obarray, and store the index of
|
||||||
;; this slot as the variable slot in this new symbol. We need to
|
;; this slot as the variable slot in this new symbol. We need to
|
||||||
|
@ -779,7 +784,7 @@ See `defclass' for more information."
|
||||||
(fset cname
|
(fset cname
|
||||||
`(lambda (newname &rest slots)
|
`(lambda (newname &rest slots)
|
||||||
,(format "Create a new object with name NAME of class type %s" cname)
|
,(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.
|
;; 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.
|
;; We have a list of custom groups. Store them into the options.
|
||||||
(let ((g (class-option-assoc options :custom-groups)))
|
(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)
|
(if (memq :custom-groups options)
|
||||||
(setcar (cdr (memq :custom-groups options)) g)
|
(setcar (cdr (memq :custom-groups options)) g)
|
||||||
(setq options (cons :custom-groups (cons g options)))))
|
(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.
|
"Copy into NEWC the slots of PARENTS.
|
||||||
Follow the rules of not overwriting early parents when applying to
|
Follow the rules of not overwriting early parents when applying to
|
||||||
the new child class."
|
the new child class."
|
||||||
|
@ -1178,6 +1183,8 @@ DOC-STRING is the documentation attached to METHOD."
|
||||||
(let ((doc-string (documentation method)))
|
(let ((doc-string (documentation method)))
|
||||||
(fset method (eieio-defgeneric-form-primary-only method doc-string))))
|
(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
|
(defun eieio-defgeneric-form-primary-only-one (method doc-string
|
||||||
class
|
class
|
||||||
impl
|
impl
|
||||||
|
@ -1212,7 +1219,7 @@ IMPL is the symbol holding the method implementation."
|
||||||
',class)))
|
',class)))
|
||||||
|
|
||||||
;; If not the right kind of object, call no applicable
|
;; 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)
|
',method local-args)
|
||||||
|
|
||||||
;; It is ok, do the call.
|
;; 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
|
;; 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
|
;; requiring the CL library at run-time. It can be eliminated if/when
|
||||||
;; `typep' is merged into Emacs core.
|
;; `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)
|
(defun eieio-perform-slot-validation (spec value)
|
||||||
"Return non-nil if SPEC does not match VALUE."
|
"Return non-nil if SPEC does not match VALUE."
|
||||||
(or (eq spec t) ; t always passes
|
(or (eq spec t) ; t always passes
|
||||||
(eq value eieio-unbound) ; unbound 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)
|
(defun eieio-validate-slot-value (class slot-idx value slot)
|
||||||
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
|
"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.
|
;; applicable.
|
||||||
(eieio-c3-merge-lists
|
(eieio-c3-merge-lists
|
||||||
(cons next reversed-partial-result)
|
(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))
|
remaining-inputs))
|
||||||
;; The graph is inconsistent, give up
|
;; The graph is inconsistent, give up
|
||||||
(signal 'inconsistent-class-hierarchy (list remaining-inputs))))))
|
(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."
|
method invocation orders of the involved classes."
|
||||||
(if (or (null class) (eq class 'eieio-default-superclass))
|
(if (or (null class) (eq class 'eieio-default-superclass))
|
||||||
nil
|
nil
|
||||||
(case (class-method-invocation-order class)
|
(cl-case (class-method-invocation-order class)
|
||||||
(:depth-first
|
(:depth-first
|
||||||
(eieio-class-precedence-dfs class))
|
(eieio-class-precedence-dfs class))
|
||||||
(:breadth-first
|
(: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
|
;; Now loop through all occurrences forms which we must execute
|
||||||
;; (which are happily sorted now) and execute them all!
|
;; (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
|
(while lambdas
|
||||||
(if (car lambdas)
|
(if (car lambdas)
|
||||||
(eieio--with-scoped-class (cdr (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 rval (apply (car (car lambdas)) newargs))
|
||||||
(setq lastval (apply (car (car lambdas)) newargs))
|
(setq lastval (apply (car (car lambdas)) newargs))
|
||||||
(when has-return-val
|
(when has-return-val
|
||||||
(setq rval lastval
|
(setq rval lastval))
|
||||||
rvalever t))
|
|
||||||
)))
|
)))
|
||||||
(setq lambdas (cdr lambdas)
|
(setq lambdas (cdr lambdas)
|
||||||
keys (cdr keys)))
|
keys (cdr keys)))
|
||||||
(if (not found)
|
(if (not found)
|
||||||
(if (eieio-object-p (car args))
|
(if (eieio-object-p (car args))
|
||||||
(setq rval (apply 'no-applicable-method (car args) method args)
|
(setq rval (apply #'no-applicable-method (car args) method args))
|
||||||
rvalever t)
|
|
||||||
(signal
|
(signal
|
||||||
'no-method-definition
|
'no-method-definition
|
||||||
(list method args))))
|
(list method args))))
|
||||||
;; Right Here... it could be that lastval is returned when
|
|
||||||
;; rvalever is nil. Is that right?
|
|
||||||
rval)))
|
rval)))
|
||||||
|
|
||||||
(defun eieio-generic-call-primary-only (method args)
|
(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
|
;; Now loop through all occurrences forms which we must execute
|
||||||
;; (which are happily sorted now) and execute them all!
|
;; (which are happily sorted now) and execute them all!
|
||||||
(eieio--with-scoped-class (cdr lambdas)
|
(eieio--with-scoped-class (cdr lambdas)
|
||||||
(let* ((rval nil) (lastval nil) (rvalever nil)
|
(let* ((rval nil) (lastval nil)
|
||||||
(eieio-generic-call-key method-primary)
|
(eieio-generic-call-key method-primary)
|
||||||
;; Use the cdr, as the first element is the fcn
|
;; Use the cdr, as the first element is the fcn
|
||||||
;; we are calling right now.
|
;; we are calling right now.
|
||||||
|
@ -1931,8 +1893,8 @@ for this common case to improve performance."
|
||||||
|
|
||||||
;; No methods found for this impl...
|
;; No methods found for this impl...
|
||||||
(if (eieio-object-p (car args))
|
(if (eieio-object-p (car args))
|
||||||
(setq rval (apply 'no-applicable-method (car args) method args)
|
(setq rval (apply #'no-applicable-method
|
||||||
rvalever t)
|
(car args) method args))
|
||||||
(signal
|
(signal
|
||||||
'no-method-definition
|
'no-method-definition
|
||||||
(list method args)))
|
(list method args)))
|
||||||
|
@ -1943,12 +1905,8 @@ for this common case to improve performance."
|
||||||
lambdas)
|
lambdas)
|
||||||
|
|
||||||
(setq lastval (apply (car lambdas) newargs))
|
(setq lastval (apply (car lambdas) newargs))
|
||||||
(setq rval lastval
|
(setq rval lastval))
|
||||||
rvalever t)
|
|
||||||
)
|
|
||||||
|
|
||||||
;; Right Here... it could be that lastval is returned when
|
|
||||||
;; rvalever is nil. Is that right?
|
|
||||||
rval))))
|
rval))))
|
||||||
|
|
||||||
(defun eieiomt-method-list (method key class)
|
(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)
|
(when (string-match "\\.elc$" fname)
|
||||||
(setq fname (substring fname 0 (1- (length fname)))))
|
(setq fname (substring fname 0 (1- (length fname)))))
|
||||||
(setq loc (get method-name 'method-locations))
|
(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)))
|
(put method-name 'method-locations loc)))
|
||||||
;; Now optimize the entire obarray
|
;; Now optimize the entire obarray
|
||||||
(if (< key method-num-lists)
|
(if (< key method-num-lists)
|
||||||
|
@ -2084,7 +2042,8 @@ nil for superclasses. This function performs no type checking!"
|
||||||
;; we replace the nil from above.
|
;; we replace the nil from above.
|
||||||
(let ((external-symbol (intern-soft (symbol-name s))))
|
(let ((external-symbol (intern-soft (symbol-name s))))
|
||||||
(catch 'done
|
(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)
|
(let ((ov (intern-soft (symbol-name ancestor)
|
||||||
eieiomt-optimizing-obarray)))
|
eieiomt-optimizing-obarray)))
|
||||||
(when (fboundp ov)
|
(when (fboundp ov)
|
||||||
|
|
|
@ -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
|
;;; or maybe Eric's Implementation of Emacs Interpreted Objects
|
||||||
|
|
||||||
;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc.
|
;; Copyright (C) 1995-1996, 1998-2014 Free Software Foundation, Inc.
|
||||||
|
@ -44,8 +44,6 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
|
|
||||||
|
|
||||||
(defvar eieio-version "1.4"
|
(defvar eieio-version "1.4"
|
||||||
"Current version of EIEIO.")
|
"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,
|
Due to the way class options are set up, you can add any tags you wish,
|
||||||
and reference them using the function `class-option'."
|
and reference them using the function `class-option'."
|
||||||
|
(declare (doc-string 4))
|
||||||
;; This is eval-and-compile only to silence spurious compiler warnings
|
;; This is eval-and-compile only to silence spurious compiler warnings
|
||||||
;; about functions and variables not known to be defined.
|
;; about functions and variables not known to be defined.
|
||||||
;; When eieio-defclass code is merged here and this becomes
|
;; When eieio-defclass code is merged here and this becomes
|
||||||
|
@ -155,7 +154,7 @@ a string."
|
||||||
|
|
||||||
;;; CLOS methods and generics
|
;;; CLOS methods and generics
|
||||||
;;
|
;;
|
||||||
(defmacro defgeneric (method args &optional doc-string)
|
(defmacro defgeneric (method _args &optional doc-string)
|
||||||
"Create a generic function METHOD.
|
"Create a generic function METHOD.
|
||||||
DOC-STRING is the base documentation for this class. A generic
|
DOC-STRING is the base documentation for this class. A generic
|
||||||
function has no body, as its purpose is to decide which method body
|
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
|
`defgeneric' for you. With this implementation the ARGS are
|
||||||
currently ignored. You can use `defgeneric' to apply specialized
|
currently ignored. You can use `defgeneric' to apply specialized
|
||||||
top level documentation to a method."
|
top level documentation to a method."
|
||||||
|
(declare (doc-string 3))
|
||||||
`(eieio--defalias ',method
|
`(eieio--defalias ',method
|
||||||
(eieio--defgeneric-init-form ',method ,doc-string)))
|
(eieio--defgeneric-init-form ',method ,doc-string)))
|
||||||
|
|
||||||
|
@ -191,6 +191,7 @@ Summary:
|
||||||
((typearg class-name) arg2 &optional opt &rest rest)
|
((typearg class-name) arg2 &optional opt &rest rest)
|
||||||
\"doc-string\"
|
\"doc-string\"
|
||||||
body)"
|
body)"
|
||||||
|
(declare (doc-string 3))
|
||||||
(let* ((key (if (keywordp (car args)) (pop args)))
|
(let* ((key (if (keywordp (car args)) (pop args)))
|
||||||
(params (car args))
|
(params (car args))
|
||||||
(arg1 (car params))
|
(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
|
SLOT. A slot specified without a variable name is given a
|
||||||
variable name of the same name as the slot."
|
variable name of the same name as the slot."
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
|
(require 'cl-lib)
|
||||||
;; Transform the spec-list into a cl-symbol-macrolet spec-list.
|
;; Transform the spec-list into a cl-symbol-macrolet spec-list.
|
||||||
(let ((mappings (mapcar (lambda (entry)
|
(let ((mappings (mapcar (lambda (entry)
|
||||||
(let ((var (if (listp entry) (car entry) 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))
|
(next (car eieio-generic-call-next-method-list))
|
||||||
)
|
)
|
||||||
(if (or (not next) (not (car next)))
|
(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
|
(let* ((eieio-generic-call-next-method-list
|
||||||
(cdr eieio-generic-call-next-method-list))
|
(cdr eieio-generic-call-next-method-list))
|
||||||
(eieio-generic-call-arglst newargs)
|
(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
|
;;; Here are some CLOS items that need the CL package
|
||||||
;;
|
;;
|
||||||
|
|
||||||
(defsetf eieio-oref eieio-oset)
|
(gv-define-simple-setter 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))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -651,7 +633,7 @@ dynamically set from SLOTS."
|
||||||
"Method invoked when an attempt to access a slot in OBJECT fails.")
|
"Method invoked when an attempt to access a slot in OBJECT fails.")
|
||||||
|
|
||||||
(defmethod slot-missing ((object eieio-default-superclass) slot-name
|
(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.
|
"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
|
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
|
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.")
|
"Called if there are no implementations for OBJECT in METHOD.")
|
||||||
|
|
||||||
(defmethod no-applicable-method ((object eieio-default-superclass)
|
(defmethod no-applicable-method ((object eieio-default-superclass)
|
||||||
method &rest args)
|
method &rest _args)
|
||||||
"Called if there are no implementations for OBJECT in METHOD.
|
"Called if there are no implementations for OBJECT in METHOD.
|
||||||
OBJECT is the object which has no method implementation.
|
OBJECT is the object which has no method implementation.
|
||||||
ARGS are the arguments that were passed to METHOD.
|
ARGS are the arguments that were passed to METHOD.
|
||||||
|
@ -734,7 +716,7 @@ first and modify the returned object.")
|
||||||
(defgeneric destructor (this &rest params)
|
(defgeneric destructor (this &rest params)
|
||||||
"Destructor for cleaning up any dynamic links to our object.")
|
"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.
|
"Destructor for cleaning up any dynamic links to our object.
|
||||||
Argument THIS is the object being destroyed. PARAMS are additional
|
Argument THIS is the object being destroyed. PARAMS are additional
|
||||||
ignored parameters."
|
ignored parameters."
|
||||||
|
@ -760,7 +742,7 @@ Implement this function and specify STRINGS in a call to
|
||||||
`call-next-method' to provide additional summary information.
|
`call-next-method' to provide additional summary information.
|
||||||
When passing in extra strings from child classes, always remember
|
When passing in extra strings from child classes, always remember
|
||||||
to prepend a space."
|
to prepend a space."
|
||||||
(eieio-object-name this (apply 'concat strings)))
|
(eieio-object-name this (apply #'concat strings)))
|
||||||
|
|
||||||
(defvar eieio-print-depth 0
|
(defvar eieio-print-depth 0
|
||||||
"When printing, keep track of the current indentation depth.")
|
"When printing, keep track of the current indentation depth.")
|
||||||
|
@ -859,7 +841,7 @@ this object."
|
||||||
|
|
||||||
;;; Unimplemented functions from CLOS
|
;;; Unimplemented functions from CLOS
|
||||||
;;
|
;;
|
||||||
(defun change-class (obj class)
|
(defun change-class (_obj _class)
|
||||||
"Change the class of OBJ to type CLASS.
|
"Change the class of OBJ to type CLASS.
|
||||||
This may create or delete slots, but does not affect the return value
|
This may create or delete slots, but does not affect the return value
|
||||||
of `eq'."
|
of `eq'."
|
||||||
|
@ -879,7 +861,8 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
|
||||||
((eieio-object-p object) (object-print object))
|
((eieio-object-p object) (object-print object))
|
||||||
((and (listp object) (or (class-p (car object))
|
((and (listp object) (or (class-p (car object))
|
||||||
(eieio-object-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))))
|
(t (prin1-to-string object noescape))))
|
||||||
|
|
||||||
(add-hook 'edebug-setup-hook
|
(add-hook 'edebug-setup-hook
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue