Commit 1dfd6b40 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

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.
parent c89dc27c
Pipeline #2124 failed with stage
in 50 minutes and 51 seconds
...@@ -53,10 +53,13 @@ It does not need refreshing." ...@@ -53,10 +53,13 @@ It does not need refreshing."
"Return nil, we never need a refresh." "Return nil, we never need a refresh."
nil) nil)
(cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings) (cl-defmethod semanticdb-debug-info ((obj semanticdb-table-emacs-lisp))
"Pretty printer extension for `semanticdb-table-emacs-lisp'. (list "(proxy)"))
Adds the number of tags in this file to the object print name."
(apply #'cl-call-next-method obj (cons " (proxy)" strings))) (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 (defclass semanticdb-project-database-emacs-lisp
(semanticdb-project-database eieio-singleton) (semanticdb-project-database eieio-singleton)
...@@ -67,14 +70,19 @@ Adds the number of tags in this file to the object print name." ...@@ -67,14 +70,19 @@ Adds the number of tags in this file to the object print name."
) )
"Database representing Emacs core.") "Database representing Emacs core.")
(cl-defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings) (cl-defmethod semanticdb-debug-info ((obj
"Pretty printer extension for `semanticdb-table-emacs-lisp'. semanticdb-project-database-emacs-lisp))
Adds the number of tags in this file to the object print name."
(let ((count 0)) (let ((count 0))
(mapatoms (lambda (_sym) (setq count (1+ count)))) (mapatoms (lambda (_sym) (setq count (1+ count))))
(apply #'cl-call-next-method obj (cons (append (cl-call-next-method obj)
(format " (%d known syms)" count) (list (format "(%d known syms)" count)))))
strings))))
(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. ;; Create the database, and add it to searchable databases for Emacs Lisp mode.
(defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases (defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases
......
...@@ -114,10 +114,14 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error." ...@@ -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.") "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'. "Pretty printer extension for `semanticdb-table-global'.
Adds the number of tags in this file to the object print name." 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) (cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER. "Return t, pretend that this table's mode is equivalent to BUFFER.
......
...@@ -171,18 +171,6 @@ based on whichever technique used. This method provides a hook for ...@@ -171,18 +171,6 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form." them to convert TAG into a more complete form."
(cons obj tag)) (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 ;;; Index Cache
;; ;;
(defclass semanticdb-abstract-search-index () (defclass semanticdb-abstract-search-index ()
...@@ -321,13 +309,18 @@ If OBJ's file is not loaded, read it in first." ...@@ -321,13 +309,18 @@ If OBJ's file is not loaded, read it in first."
(oset obj dirty t) (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'. "Pretty printer extension for `semanticdb-table'.
Adds the number of tags in this file to the object print name." Adds the number of tags in this file to the object print name."
(apply #'cl-call-next-method obj (princ (eieio-object-name obj (semanticdb-debug-info obj))
(format " (%d tags)" (length (semanticdb-get-tags obj))) stream))
(if (oref obj dirty) ", DIRTY" "")
strings))
;;; DATABASE BASE CLASS ;;; DATABASE BASE CLASS
;; ;;
...@@ -380,16 +373,17 @@ where it may need to resynchronize with some persistent storage." ...@@ -380,16 +373,17 @@ where it may need to resynchronize with some persistent storage."
(setq tabs (cdr tabs))) (setq tabs (cdr tabs)))
dirty)) 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'. "Pretty printer extension for `semanticdb-project-database'.
Adds the number of tables in this file to the object print name." Adds the number of tables in this file to the object print name."
(apply #'cl-call-next-method obj (princ (eieio-object-name obj (semanticdb-debug-info obj))
(format " (%d tables%s)" stream))
(length (semanticdb-get-database-tables obj))
(if (semanticdb-dirty-p obj)
" DIRTY" "")
)
strings))
(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory) (cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory)
"Create a new semantic database of class DBC for DIRECTORY and return it. "Create a new semantic database of class DBC for DIRECTORY and return it.
......
...@@ -398,7 +398,14 @@ contents of field NAME is matched against PAT, or they can be of ...@@ -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." If EXTRA, include that in the string returned to represent the symbol."
(cl-check-type obj eieio-object) (cl-check-type obj eieio-object)
(format "#<%s %s%s>" (eieio-object-class obj) (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") (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
(cl-defgeneric eieio-object-set-name-string (obj name) (cl-defgeneric eieio-object-set-name-string (obj name)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment