db-debug.el 3.4 KB

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