diff options
| -rw-r--r-- | lisp/cedet/semantic/db-el.el | 28 | ||||
| -rw-r--r-- | lisp/cedet/semantic/db-global.el | 8 | ||||
| -rw-r--r-- | lisp/cedet/semantic/db.el | 44 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 9 |
4 files changed, 51 insertions, 38 deletions
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) |