mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-03 08:30:09 +00:00
Code Issues Releases Activity

Provide more control over writing of objects in object-write

Browse Source 
* 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:
Eric Abrahamsen 2017-11-08 11:58:31 -08:00
parent 00995c88dd
commit 1ef6d2b0e6
1 changed files with 25 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
lisp/emacs-lisp/eieio.el
View File

@ -847,7 +847,16 @@ to prepend a space."
(princ (object-print object) stream))
(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)
"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.
If optional COMMENT is non-nil, include comments when outputting
this object."
(when comment
(when eieio-print-object-name
(princ ";; Object ")
(princ (eieio-object-name-string this))
(princ "\n")
(princ "\n"))
(when comment
(princ comment)
(princ "\n"))
(let* ((cl (eieio-object-class this))
@ -871,11 +881,13 @@ this object."
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
;; 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 (symbol-name (eieio--class-constructor (eieio-object-class this))))
(princ " ")
(prin1 (eieio-object-name-string this))
(when eieio-print-object-name
(princ " ")
(prin1 (eieio-object-name-string this)))
(princ "\n")
;; Loop over all the public slots
(let ((slots (eieio--class-slots cv))
@ -889,7 +901,8 @@ this object."
(unless (or (not i) (equal v (cl--slot-descriptor-initform slot)))
(unless (bolp)
(princ "\n"))
(princ (make-string (* eieio-print-depth 2) ? ))
(when eieio-print-indentation
(princ (make-string (* eieio-print-depth 2) ? )))
(princ (symbol-name i))
(if (alist-get :printer (cl--slot-descriptor-props slot))
;; Use our public printer
@ -904,7 +917,7 @@ this object."
"\n" " "))
(eieio-override-prin1 v))))))))
(princ ")")
(when (= eieio-print-depth 0)
(when (zerop eieio-print-depth)
(princ "\n"))))
(defun eieio-override-prin1 (thing)
@ -923,14 +936,16 @@ this object."
(progn
(princ "'")
(prin1 list))
(princ (make-string (* eieio-print-depth 2) ? ))
(when eieio-print-indentation
(princ (make-string (* eieio-print-depth 2) ? )))
(princ "(list")
(let ((eieio-print-depth (1+ eieio-print-depth)))
(while list
(princ "\n")
(if (eieio-object-p (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)))
(setq list (cdr list))))
(princ ")")))