diff options
| author | Eric Abrahamsen | 2017-11-08 11:58:31 -0800 |
|---|---|---|
| committer | Eric Abrahamsen | 2017-11-10 17:33:57 -0800 |
| commit | 1ef6d2b0e679c035dd2a1f2f858865eeafc5bc28 (patch) | |
| tree | 0cd7d1a6b3a5131a259201683695e5f4ec4a6751 | |
| parent | 00995c88dde4f8078a843b48faef16668a126d9c (diff) | |
| download | emacs-1ef6d2b0e679c035dd2a1f2f858865eeafc5bc28.tar.gz emacs-1ef6d2b0e679c035dd2a1f2f858865eeafc5bc28.zip | |
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.
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 35 |
1 files changed, 25 insertions, 10 deletions
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index ca91c5a8711..9276fab0c39 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -847,7 +847,16 @@ to prepend a space." | |||
| 847 | (princ (object-print object) stream)) | 847 | (princ (object-print object) stream)) |
| 848 | 848 | ||
| 849 | (defvar eieio-print-depth 0 | 849 | (defvar eieio-print-depth 0 |
| 850 | "When printing, keep track of the current indentation depth.") | 850 | "The current indentation depth while printing. |
| 851 | Ignored if `eieio-print-indentation' is nil.") | ||
| 852 | |||
| 853 | (defvar eieio-print-indentation t | ||
| 854 | "When non-nil, indent contents of printed objects.") | ||
| 855 | |||
| 856 | (defvar eieio-print-object-name t | ||
| 857 | "When non-nil write the object name in `object-write'. | ||
| 858 | Does not affect objects subclassing `eieio-named'. Note that | ||
| 859 | Emacs<26 requires that object names be present.") | ||
| 851 | 860 | ||
| 852 | (cl-defgeneric object-write (this &optional comment) | 861 | (cl-defgeneric object-write (this &optional comment) |
| 853 | "Write out object THIS to the current stream. | 862 | "Write out object THIS to the current stream. |
| @@ -859,10 +868,11 @@ This writes out the vector version of this object. Complex and recursive | |||
| 859 | object are discouraged from being written. | 868 | object are discouraged from being written. |
| 860 | If optional COMMENT is non-nil, include comments when outputting | 869 | If optional COMMENT is non-nil, include comments when outputting |
| 861 | this object." | 870 | this object." |
| 862 | (when comment | 871 | (when eieio-print-object-name |
| 863 | (princ ";; Object ") | 872 | (princ ";; Object ") |
| 864 | (princ (eieio-object-name-string this)) | 873 | (princ (eieio-object-name-string this)) |
| 865 | (princ "\n") | 874 | (princ "\n")) |
| 875 | (when comment | ||
| 866 | (princ comment) | 876 | (princ comment) |
| 867 | (princ "\n")) | 877 | (princ "\n")) |
| 868 | (let* ((cl (eieio-object-class this)) | 878 | (let* ((cl (eieio-object-class this)) |
| @@ -871,11 +881,13 @@ this object." | |||
| 871 | ;; It should look like this: | 881 | ;; It should look like this: |
| 872 | ;; (<constructor> <name> <slot> <slot> ... ) | 882 | ;; (<constructor> <name> <slot> <slot> ... ) |
| 873 | ;; Each slot's slot is writen using its :writer. | 883 | ;; Each slot's slot is writen using its :writer. |
| 874 | (princ (make-string (* eieio-print-depth 2) ? )) | 884 | (when eieio-print-indentation |
| 885 | (princ (make-string (* eieio-print-depth 2) ? ))) | ||
| 875 | (princ "(") | 886 | (princ "(") |
| 876 | (princ (symbol-name (eieio--class-constructor (eieio-object-class this)))) | 887 | (princ (symbol-name (eieio--class-constructor (eieio-object-class this)))) |
| 877 | (princ " ") | 888 | (when eieio-print-object-name |
| 878 | (prin1 (eieio-object-name-string this)) | 889 | (princ " ") |
| 890 | (prin1 (eieio-object-name-string this))) | ||
| 879 | (princ "\n") | 891 | (princ "\n") |
| 880 | ;; Loop over all the public slots | 892 | ;; Loop over all the public slots |
| 881 | (let ((slots (eieio--class-slots cv)) | 893 | (let ((slots (eieio--class-slots cv)) |
| @@ -889,7 +901,8 @@ this object." | |||
| 889 | (unless (or (not i) (equal v (cl--slot-descriptor-initform slot))) | 901 | (unless (or (not i) (equal v (cl--slot-descriptor-initform slot))) |
| 890 | (unless (bolp) | 902 | (unless (bolp) |
| 891 | (princ "\n")) | 903 | (princ "\n")) |
| 892 | (princ (make-string (* eieio-print-depth 2) ? )) | 904 | (when eieio-print-indentation |
| 905 | (princ (make-string (* eieio-print-depth 2) ? ))) | ||
| 893 | (princ (symbol-name i)) | 906 | (princ (symbol-name i)) |
| 894 | (if (alist-get :printer (cl--slot-descriptor-props slot)) | 907 | (if (alist-get :printer (cl--slot-descriptor-props slot)) |
| 895 | ;; Use our public printer | 908 | ;; Use our public printer |
| @@ -904,7 +917,7 @@ this object." | |||
| 904 | "\n" " ")) | 917 | "\n" " ")) |
| 905 | (eieio-override-prin1 v)))))))) | 918 | (eieio-override-prin1 v)))))))) |
| 906 | (princ ")") | 919 | (princ ")") |
| 907 | (when (= eieio-print-depth 0) | 920 | (when (zerop eieio-print-depth) |
| 908 | (princ "\n")))) | 921 | (princ "\n")))) |
| 909 | 922 | ||
| 910 | (defun eieio-override-prin1 (thing) | 923 | (defun eieio-override-prin1 (thing) |
| @@ -923,14 +936,16 @@ this object." | |||
| 923 | (progn | 936 | (progn |
| 924 | (princ "'") | 937 | (princ "'") |
| 925 | (prin1 list)) | 938 | (prin1 list)) |
| 926 | (princ (make-string (* eieio-print-depth 2) ? )) | 939 | (when eieio-print-indentation |
| 940 | (princ (make-string (* eieio-print-depth 2) ? ))) | ||
| 927 | (princ "(list") | 941 | (princ "(list") |
| 928 | (let ((eieio-print-depth (1+ eieio-print-depth))) | 942 | (let ((eieio-print-depth (1+ eieio-print-depth))) |
| 929 | (while list | 943 | (while list |
| 930 | (princ "\n") | 944 | (princ "\n") |
| 931 | (if (eieio-object-p (car list)) | 945 | (if (eieio-object-p (car list)) |
| 932 | (object-write (car list)) | 946 | (object-write (car list)) |
| 933 | (princ (make-string (* eieio-print-depth 2) ? )) | 947 | (when eieio-print-indentation |
| 948 | (princ (make-string (* eieio-print-depth) ? ))) | ||
| 934 | (eieio-override-prin1 (car list))) | 949 | (eieio-override-prin1 (car list))) |
| 935 | (setq list (cdr list)))) | 950 | (setq list (cdr list)))) |
| 936 | (princ ")"))) | 951 | (princ ")"))) |