Provide more control over writing of objects in object-write
* lisp/emacs-lisp/eieio.el (eieio-print-indentation, eieio-print-object-name): New variables controlling whether an object name is printed for each object, and whether an object's contents are indented or not. Object names are obsoleted; omitting indentation reduces the size of persistence files.
This commit is contained in:
parent
00995c88dd
commit
1ef6d2b0e6
1 changed files with 25 additions and 10 deletions
|
@ -847,7 +847,16 @@ to prepend a space."
|
||||||
(princ (object-print object) stream))
|
(princ (object-print object) stream))
|
||||||
|
|
||||||
(defvar eieio-print-depth 0
|
(defvar eieio-print-depth 0
|
||||||
"When printing, keep track of the current indentation depth.")
|
"The current indentation depth while printing.
|
||||||
|
Ignored if `eieio-print-indentation' is nil.")
|
||||||
|
|
||||||
|
(defvar eieio-print-indentation t
|
||||||
|
"When non-nil, indent contents of printed objects.")
|
||||||
|
|
||||||
|
(defvar eieio-print-object-name t
|
||||||
|
"When non-nil write the object name in `object-write'.
|
||||||
|
Does not affect objects subclassing `eieio-named'. Note that
|
||||||
|
Emacs<26 requires that object names be present.")
|
||||||
|
|
||||||
(cl-defgeneric object-write (this &optional comment)
|
(cl-defgeneric object-write (this &optional comment)
|
||||||
"Write out object THIS to the current stream.
|
"Write out object THIS to the current stream.
|
||||||
|
@ -859,10 +868,11 @@ This writes out the vector version of this object. Complex and recursive
|
||||||
object are discouraged from being written.
|
object are discouraged from being written.
|
||||||
If optional COMMENT is non-nil, include comments when outputting
|
If optional COMMENT is non-nil, include comments when outputting
|
||||||
this object."
|
this object."
|
||||||
(when comment
|
(when eieio-print-object-name
|
||||||
(princ ";; Object ")
|
(princ ";; Object ")
|
||||||
(princ (eieio-object-name-string this))
|
(princ (eieio-object-name-string this))
|
||||||
(princ "\n")
|
(princ "\n"))
|
||||||
|
(when comment
|
||||||
(princ comment)
|
(princ comment)
|
||||||
(princ "\n"))
|
(princ "\n"))
|
||||||
(let* ((cl (eieio-object-class this))
|
(let* ((cl (eieio-object-class this))
|
||||||
|
@ -871,11 +881,13 @@ this object."
|
||||||
;; It should look like this:
|
;; It should look like this:
|
||||||
;; (<constructor> <name> <slot> <slot> ... )
|
;; (<constructor> <name> <slot> <slot> ... )
|
||||||
;; Each slot's slot is writen using its :writer.
|
;; Each slot's slot is writen using its :writer.
|
||||||
(princ (make-string (* eieio-print-depth 2) ? ))
|
(when eieio-print-indentation
|
||||||
|
(princ (make-string (* eieio-print-depth 2) ? )))
|
||||||
(princ "(")
|
(princ "(")
|
||||||
(princ (symbol-name (eieio--class-constructor (eieio-object-class this))))
|
(princ (symbol-name (eieio--class-constructor (eieio-object-class this))))
|
||||||
(princ " ")
|
(when eieio-print-object-name
|
||||||
(prin1 (eieio-object-name-string this))
|
(princ " ")
|
||||||
|
(prin1 (eieio-object-name-string this)))
|
||||||
(princ "\n")
|
(princ "\n")
|
||||||
;; Loop over all the public slots
|
;; Loop over all the public slots
|
||||||
(let ((slots (eieio--class-slots cv))
|
(let ((slots (eieio--class-slots cv))
|
||||||
|
@ -889,7 +901,8 @@ this object."
|
||||||
(unless (or (not i) (equal v (cl--slot-descriptor-initform slot)))
|
(unless (or (not i) (equal v (cl--slot-descriptor-initform slot)))
|
||||||
(unless (bolp)
|
(unless (bolp)
|
||||||
(princ "\n"))
|
(princ "\n"))
|
||||||
(princ (make-string (* eieio-print-depth 2) ? ))
|
(when eieio-print-indentation
|
||||||
|
(princ (make-string (* eieio-print-depth 2) ? )))
|
||||||
(princ (symbol-name i))
|
(princ (symbol-name i))
|
||||||
(if (alist-get :printer (cl--slot-descriptor-props slot))
|
(if (alist-get :printer (cl--slot-descriptor-props slot))
|
||||||
;; Use our public printer
|
;; Use our public printer
|
||||||
|
@ -904,7 +917,7 @@ this object."
|
||||||
"\n" " "))
|
"\n" " "))
|
||||||
(eieio-override-prin1 v))))))))
|
(eieio-override-prin1 v))))))))
|
||||||
(princ ")")
|
(princ ")")
|
||||||
(when (= eieio-print-depth 0)
|
(when (zerop eieio-print-depth)
|
||||||
(princ "\n"))))
|
(princ "\n"))))
|
||||||
|
|
||||||
(defun eieio-override-prin1 (thing)
|
(defun eieio-override-prin1 (thing)
|
||||||
|
@ -923,14 +936,16 @@ this object."
|
||||||
(progn
|
(progn
|
||||||
(princ "'")
|
(princ "'")
|
||||||
(prin1 list))
|
(prin1 list))
|
||||||
(princ (make-string (* eieio-print-depth 2) ? ))
|
(when eieio-print-indentation
|
||||||
|
(princ (make-string (* eieio-print-depth 2) ? )))
|
||||||
(princ "(list")
|
(princ "(list")
|
||||||
(let ((eieio-print-depth (1+ eieio-print-depth)))
|
(let ((eieio-print-depth (1+ eieio-print-depth)))
|
||||||
(while list
|
(while list
|
||||||
(princ "\n")
|
(princ "\n")
|
||||||
(if (eieio-object-p (car list))
|
(if (eieio-object-p (car list))
|
||||||
(object-write (car list))
|
(object-write (car list))
|
||||||
(princ (make-string (* eieio-print-depth 2) ? ))
|
(when eieio-print-indentation
|
||||||
|
(princ (make-string (* eieio-print-depth) ? )))
|
||||||
(eieio-override-prin1 (car list)))
|
(eieio-override-prin1 (car list)))
|
||||||
(setq list (cdr list))))
|
(setq list (cdr list))))
|
||||||
(princ ")")))
|
(princ ")")))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue