From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 17 Jun 2019 09:22:21 +0000 (+0200)
Subject: Rewrite object-print methods in cedet to be cl-print-object methods
X-Git-Tag: emacs-27.0.90~2453
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1dfd6b404236273f89071214288eb471018299e9;p=emacs.git

Rewrite object-print methods in cedet to be cl-print-object methods

* lisp/cedet/semantic/db-el.el (object-print): Ditto.
(object-print): Ditto.

* lisp/cedet/semantic/db-global.el (object-print): Ditto.

* lisp/cedet/semantic/db.el (object-print): Remove; unused.
* lisp/cedet/semantic/db.el (semanticdb-debug-info): New method.
(object-print): Rewritten to be cl-print-object.

* lisp/emacs-lisp/eieio.el (eieio-object-name): Allow the EXTRA
argument to be a list of strings.
---

diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 5375623c132..39d61fe789b 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -53,10 +53,13 @@ It does not need refreshing."
   "Return nil, we never need a refresh."
   nil)
 
-(cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
-  "Pretty printer extension for `semanticdb-table-emacs-lisp'.
-Adds the number of tags in this file to the object print name."
-  (apply #'cl-call-next-method obj (cons " (proxy)" strings)))
+(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-emacs-lisp))
+  (list "(proxy)"))
+
+(cl-defmethod cl-print-object ((obj semanticdb-table-emacs-lisp) stream)
+  "Pretty printer extension for `semanticdb-table-emacs-lisp'."
+  (princ (eieio-object-name obj (semanticdb-debug-info obj))
+         stream))
 
 (defclass semanticdb-project-database-emacs-lisp
   (semanticdb-project-database eieio-singleton)
@@ -67,14 +70,19 @@ Adds the number of tags in this file to the object print name."
    )
   "Database representing Emacs core.")
 
-(cl-defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
-  "Pretty printer extension for `semanticdb-table-emacs-lisp'.
-Adds the number of tags in this file to the object print name."
+(cl-defmethod semanticdb-debug-info ((obj
+                                      semanticdb-project-database-emacs-lisp))
   (let ((count 0))
     (mapatoms (lambda (_sym) (setq count (1+ count))))
-    (apply #'cl-call-next-method obj (cons
-                                      (format " (%d known syms)" count)
-                                      strings))))
+    (append (cl-call-next-method obj)
+            (list (format "(%d known syms)" count)))))
+
+(cl-defmethod cl-print-object ((obj semanticdb-project-database-emacs-lisp)
+                               stream)
+  "Pretty printer extension for `semanticdb-table-emacs-lisp'.
+Adds the number of tags in this file to the object print name."
+  (princ (eieio-object-name obj (semanticdb-debug-info obj))
+         stream))
 
 ;; Create the database, and add it to searchable databases for Emacs Lisp mode.
 (defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index 7592b004e4e..0fff96d0c6a 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -114,10 +114,14 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
    )
   "A table for returning search results from GNU Global.")
 
-(cl-defmethod object-print ((obj semanticdb-table-global) &rest strings)
+(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-global))
+  (list "(proxy)"))
+
+(cl-defmethod cl-print-object ((obj semanticdb-table-global) stream)
   "Pretty printer extension for `semanticdb-table-global'.
 Adds the number of tags in this file to the object print name."
-  (apply #'cl-call-next-method obj (cons " (proxy)" strings)))
+  (princ (eieio-object-name obj (semanticdb-debug-info obj))
+         stream))
 
 (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
   "Return t, pretend that this table's mode is equivalent to BUFFER.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 1987bc07e29..33ad4701769 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -171,18 +171,6 @@ based on whichever technique used.  This method provides a hook for
 them to convert TAG into a more complete form."
   (cons obj tag))
 
-(cl-defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
-  "Pretty printer extension for `semanticdb-abstract-table'.
-Adds the number of tags in this file to the object print name."
-  (if (or (not strings)
-	  (and (= (length strings) 1) (stringp (car strings))
-	       (string= (car strings) "")))
-      ;; Else, add a tags quantifier.
-      (cl-call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
-    ;; Pass through.
-    (apply #'cl-call-next-method obj strings)
-    ))
-
 ;;; Index Cache
 ;;
 (defclass semanticdb-abstract-search-index ()
@@ -321,13 +309,18 @@ If OBJ's file is not loaded, read it in first."
   (oset obj dirty t)
   )
 
-(cl-defmethod object-print ((obj semanticdb-table) &rest strings)
+(cl-defmethod semanticdb-debug-info ((obj semanticdb-table))
+  (list (format "(%d tags)%s"
+                (length (semanticdb-get-tags obj))
+                (if (oref obj dirty)
+                    ", DIRTY"
+                  ""))))
+
+(cl-defmethod cl-print-object ((obj semanticdb-table) stream)
   "Pretty printer extension for `semanticdb-table'.
 Adds the number of tags in this file to the object print name."
-  (apply #'cl-call-next-method obj
-	 (format " (%d tags)" (length (semanticdb-get-tags obj)))
-         (if (oref obj dirty) ", DIRTY" "")
-         strings))
+  (princ (eieio-object-name obj (semanticdb-debug-info obj))
+         stream))
 
 ;;; DATABASE BASE CLASS
 ;;
@@ -380,16 +373,17 @@ where it may need to resynchronize with some persistent storage."
       (setq tabs (cdr tabs)))
     dirty))
 
-(cl-defmethod object-print ((obj semanticdb-project-database) &rest strings)
+(cl-defmethod semanticdb-debug-info ((obj semanticdb-project-database))
+  (list (format "(%d tables%s)"
+                (length (semanticdb-get-database-tables obj))
+                (if (semanticdb-dirty-p obj)
+                    " DIRTY" ""))))
+
+(cl-defmethod cl-print-object ((obj semanticdb-project-database) stream)
   "Pretty printer extension for `semanticdb-project-database'.
 Adds the number of tables in this file to the object print name."
-  (apply #'cl-call-next-method obj
-	 (format " (%d tables%s)"
-                 (length (semanticdb-get-database-tables obj))
-                 (if (semanticdb-dirty-p obj)
-                     " DIRTY" "")
-                 )
-         strings))
+  (princ (eieio-object-name obj (semanticdb-debug-info obj))
+         stream))
 
 (cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory)
   "Create a new semantic database of class DBC for DIRECTORY and return it.
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 7ad44b6d26c..5bb08ee3e37 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -398,7 +398,14 @@ contents of field NAME is matched against PAT, or they can be of
 If EXTRA, include that in the string returned to represent the symbol."
   (cl-check-type obj eieio-object)
   (format "#<%s %s%s>" (eieio-object-class obj)
-	  (eieio-object-name-string obj) (or extra "")))
+	  (eieio-object-name-string obj)
+          (cond
+           ((null extra)
+            "")
+           ((listp extra)
+            (concat " " (mapconcat #'identity extra " ")))
+           (t
+            extra))))
 (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
 
 (cl-defgeneric eieio-object-set-name-string (obj name)