]> code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/db-debug.el
Update copyright year to 2014 by running admin/update-copyright.
[gnu-emacs] / lisp / cedet / semantic / db-debug.el
1 ;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
2
3 ;;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
4
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22 ;;; Commentary:
23 ;;
24 ;; Various routines for debugging SemanticDB issues, or viewing
25 ;; semanticdb state.
26
27 (require 'data-debug)
28 (require 'semantic/db)
29 (require 'semantic/format)
30
31 ;;; Code:
32 ;;
33 (defun semanticdb-dump-all-table-summary ()
34 "Dump a list of all databases in Emacs memory."
35 (interactive)
36 (require 'data-debug)
37 (let ((db semanticdb-database-list))
38 (data-debug-new-buffer "*SEMANTICDB*")
39 (data-debug-insert-stuff-list db "*")))
40
41 (defalias 'semanticdb-adebug-database-list 'semanticdb-dump-all-table-summary)
42
43 (defun semanticdb-adebug-current-database ()
44 "Run ADEBUG on the current database."
45 (interactive)
46 (require 'data-debug)
47 (let ((p semanticdb-current-database)
48 )
49 (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
50 (data-debug-insert-stuff-list p "*")))
51
52 (defun semanticdb-adebug-current-table ()
53 "Run ADEBUG on the current database."
54 (interactive)
55 (require 'data-debug)
56 (let ((p semanticdb-current-table))
57 (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
58 (data-debug-insert-stuff-list p "*")))
59
60
61 (defun semanticdb-adebug-project-database-list ()
62 "Run ADEBUG on the current database."
63 (interactive)
64 (require 'data-debug)
65 (let ((p (semanticdb-current-database-list)))
66 (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
67 (data-debug-insert-stuff-list p "*")))
68
69
70 \f
71 ;;; Sanity Checks
72 ;;
73
74 (defun semanticdb-table-oob-sanity-check (cache)
75 "Validate that CACHE tags do not have any overlays in them."
76 (while cache
77 (when (semantic-overlay-p (semantic-tag-overlay cache))
78 (message "Tag %s has an erroneous overlay!"
79 (semantic-format-tag-summarize (car cache))))
80 (semanticdb-table-oob-sanity-check
81 (semantic-tag-components-with-overlays (car cache)))
82 (setq cache (cdr cache))))
83
84 (defun semanticdb-table-sanity-check (&optional table)
85 "Validate the current semanticdb TABLE."
86 (interactive)
87 (if (not table) (setq table semanticdb-current-table))
88 (let* ((full-filename (semanticdb-full-filename table))
89 (buff (find-buffer-visiting full-filename)))
90 (if buff
91 (with-current-buffer buff
92 (semantic-sanity-check))
93 ;; We can't use the usual semantic validity check, so hack our own.
94 (semanticdb-table-oob-sanity-check (semanticdb-get-tags table)))))
95
96 (defun semanticdb-database-sanity-check ()
97 "Validate the current semantic database."
98 (interactive)
99 (let ((tables (semanticdb-get-database-tables
100 semanticdb-current-database)))
101 (while tables
102 (semanticdb-table-sanity-check (car tables))
103 (setq tables (cdr tables)))
104 ))
105
106
107
108 (provide 'semantic/db-debug)
109
110 ;;; semantic/db-debug.el ends here