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."
"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
......
......@@ -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.
......
......@@ -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.
......
......@@ -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)
......
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