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.
This commit is contained in:
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user