diff options
Diffstat (limited to 'lisp/emacs-lisp/eieio.el')
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 67 |
1 files changed, 41 insertions, 26 deletions
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 38436d1f944..b6ec191e2ba 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -377,9 +377,21 @@ contents of field NAME is matched against PAT, or they can be of (define-obsolete-function-alias 'object-class-fast #'eieio-object-class "24.4") +;; In the past, every EIEIO object had a `name' field, so we had the +;; two methods `eieio-object-name-string' and +;; `eieio-object-set-name-string' "for free". Since this field is +;; very rarely used, we got rid of it and instead we keep it in a weak +;; hash-tables, for those very rare objects that use it. +;; Really, those rare objects should inherit from `eieio-named' instead! +(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key)) + (cl-defgeneric eieio-object-name-string (obj) "Return a string which is OBJ's name." - (declare (obsolete eieio-named "25.1"))) + (or (gethash obj eieio--object-names) + (format "%s-%x" (eieio-object-class obj) (sxhash-eq obj)))) + +(define-obsolete-function-alias + 'object-name-string #'eieio-object-name-string "24.4") (defun eieio-object-name (obj &optional extra) "Return a printed representation for object OBJ. @@ -389,21 +401,9 @@ If EXTRA, include that in the string returned to represent the symbol." (eieio-object-name-string obj) (or extra ""))) (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") -(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key)) - -;; In the past, every EIEIO object had a `name' field, so we had the two method -;; below "for free". Since this field is very rarely used, we got rid of it -;; and instead we keep it in a weak hash-tables, for those very rare objects -;; that use it. -(cl-defmethod eieio-object-name-string (obj) - (or (gethash obj eieio--object-names) - (symbol-name (eieio-object-class obj)))) -(define-obsolete-function-alias - 'object-name-string #'eieio-object-name-string "24.4") - -(cl-defmethod eieio-object-set-name-string (obj name) +(cl-defgeneric eieio-object-set-name-string (obj name) "Set the string which is OBJ's NAME." - (declare (obsolete eieio-named "25.1")) + (declare (obsolete "inherit from `eieio-named' and use (setf (slot-value OBJ \\='object-name) NAME) instead" "25.1")) (cl-check-type name string) (setf (gethash obj eieio--object-names) name)) (define-obsolete-function-alias @@ -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 (and comment 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,12 +881,14 @@ 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)) - (princ "\n") + (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)) (eieio-print-depth (1+ eieio-print-depth))) @@ -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) @@ -942,14 +955,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 ")"))) |