>From aef73b345dde80eaed4569afc254e36af544ca87 Mon Sep 17 00:00:00 2001 From: Eric Abrahamsen Date: Thu, 27 Aug 2020 17:58:03 -0700 Subject: [PATCH 2/2] New eieio-persistent-make-instance generic function This allows override of the read process for eieio-persistent objects, providing the possibility of matching read/write customization for eieio-persistent subclasses. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-make-instance): New generic function for constructing instances from object data written to disk. Previously known as eieio-persistent-convert-list-to-object. --- lisp/emacs-lisp/eieio-base.el | 80 +++++++++++++++++------------------ 1 file changed, 39 insertions(+), 41 deletions(-) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index f09d1997ee..39ad30afc5 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -252,44 +252,41 @@ eieio-persistent-read (error "Invalid object: %s is not an object of class %s nor a subclass" (car ret) class)) - (setq ret (eieio-persistent-convert-list-to-object ret)) + (setq ret (eieio-persistent-make-instance (car ret) (cdr ret))) (oset ret file filename)) (kill-buffer " *tmp eieio read*")) ret)) -(defun eieio-persistent-convert-list-to-object (inputlist) - "Convert the INPUTLIST, representing object creation to an object. -While it is possible to just `eval' the INPUTLIST, this code instead -validates the existing list, and explicitly creates objects instead of -calling eval. This avoids the possibility of accidentally running -malicious code. - -Note: This function recurses when a slot of :type of some object is -identified, and needing more object creation." - (let ((objclass (nth 0 inputlist)) - ;; Earlier versions of `object-write' added a string name for - ;; the object, now obsolete. - (slots (nthcdr - (if (stringp (nth 1 inputlist)) 2 1) - inputlist)) - (createslots nil)) - ;; If OBJCLASS is an eieio autoload object, then we need to - ;; load it (we don't need the return value). - (eieio--full-class-object objclass) - (while slots - (let ((initarg (car slots)) - (value (car (cdr slots)))) - - ;; Strip out quotes, list functions, and update object - ;; constructors as needed. - (setq value (eieio-persistent-fix-value value)) - - (push initarg createslots) - (push value createslots)) - - (setq slots (cdr (cdr slots)))) - - (apply #'make-instance objclass (nreverse createslots)))) +(cl-defgeneric eieio-persistent-make-instance (objclass inputlist) + "Convert INPUTLIST, representing slot values, to an instance of OBJCLASS. +Clean slot values, and possibly recursively create additional +objects found there." + (:method + ((objclass (subclass eieio-default-superclass)) inputlist) + + (let ((slots (if (stringp (car inputlist)) + ;; Earlier versions of `object-write' added a + ;; string name for the object, now obsolete. + (cdr inputlist) + inputlist)) + (createslots nil)) + ;; If OBJCLASS is an eieio autoload object, then we need to + ;; load it (we don't need the return value). + (eieio--full-class-object objclass) + (while slots + (let ((initarg (car slots)) + (value (car (cdr slots)))) + + ;; Strip out quotes, list functions, and update object + ;; constructors as needed. + (setq value (eieio-persistent-fix-value value)) + + (push initarg createslots) + (push value createslots)) + + (setq slots (cdr (cdr slots)))) + + (apply #'make-instance objclass (nreverse createslots))))) (defun eieio-persistent-fix-value (proposed-value) "Fix PROPOSED-VALUE. @@ -323,7 +320,8 @@ eieio-persistent-fix-value ;; in. (let ((objlist nil)) (dolist (subobj (cdr proposed-value)) - (push (eieio-persistent-convert-list-to-object subobj) + (push (eieio-persistent-make-instance + (car subobj) (cdr subobj)) objlist)) ;; return the list of objects ... reversed. (nreverse objlist))) @@ -331,8 +329,8 @@ eieio-persistent-fix-value ;; saved here. Recurse and evaluate that ;; sub-object. ((class-p (car proposed-value)) - (eieio-persistent-convert-list-to-object - proposed-value)) + (eieio-persistent-make-instance + (car proposed-value) (cdr proposed-value))) (t proposed-value))) ;; For hash-tables and vectors, the top-level `read' will not @@ -345,8 +343,8 @@ eieio-persistent-fix-value (lambda (key value) (setf (gethash key proposed-value) (if (class-p (car-safe value)) - (eieio-persistent-convert-list-to-object - value) + (eieio-persistent-make-instance + (car value) (cdr value)) (eieio-persistent-fix-value value)))) proposed-value) proposed-value) @@ -356,8 +354,8 @@ eieio-persistent-fix-value (let ((val (aref proposed-value i))) (aset proposed-value i (if (class-p (car-safe val)) - (eieio-persistent-convert-list-to-object - val) + (eieio-persistent-make-instance + (car val) (cdr val)) (eieio-persistent-fix-value val))))) proposed-value) -- 2.28.0