lisp/cedet/semantic/db-ref.el

   1 ;;; semantic/db-ref.el --- Handle cross-db file references
   2
   3 ;;; Copyright (C) 2007, 2008, 2009 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 ;; Handle cross-database file references.
  25 ;;
  26 ;; Any given database may be referred to by some other database.  For
  27 ;; example, if a .cpp file has a #include in a header, then that
  28 ;; header file should have a reference to the .cpp file that included
  29 ;; it.
  30 ;;
  31 ;; This is critical for purposes where a file (such as a .cpp file)
  32 ;; needs to have its caches flushed because of changes in the
  33 ;; header.  Changing a header may cause a referring file to be
  34 ;; reparsed due to account for changes in defined macros, or perhaps
  35 ;; a change to files the header includes.
  36
  37
  38 ;;; Code:
  39 (require 'eieio)
  40 (require 'semantic)
  41 (require 'semantic/db)
  42 (require 'semantic/tag)
  43
  44 (defvar semanticdb-find-default-throttle)
  45
  46 ;; For the semantic-find-tags-by-name-regexp macro.
  47 (eval-when-compile (require 'semantic/find))
  48
  49 (defvar semantic-case-fold)
  50
  51 (defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
  52                                      include-tag)
  53   "Add a reference for the database table DBT based on INCLUDE-TAG.
  54 DBT is the database table that owns the INCLUDE-TAG.  The reference
  55 will be added to the database that INCLUDE-TAG refers to."
  56   ;; NOTE: I should add a check to make sure include-tag is in DB.
  57   ;;       but I'm too lazy.
  58   (let* ((semanticdb-find-default-throttle
  59                (if (featurep 'semantic/db-find)
  60                    (remq 'unloaded semanticdb-find-default-throttle)
  61                  nil))
  62          (refdbt (semanticdb-find-table-for-include include-tag dbt))
  63          ;;(fullfile (semanticdb-full-filename dbt))
  64          )
  65     (when refdbt
  66       ;; Add our filename (full path)
  67       ;; (object-add-to-list refdbt 'file-refs fullfile)
  68
  69       ;; Add our database.
  70       (object-add-to-list refdbt 'db-refs dbt)
  71       t)))
  72
  73 (defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
  74   "Check and cleanup references in the database DBT.
  75 Abstract tables would be difficult to reference."
  76   ;; Not sure how an abstract table can have references.
  77   nil)
  78
  79 (defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
  80   "Return a list of direct includes in table DBT."
  81   (semantic-find-tags-by-class 'include (semanticdb-get-tags dbt)))
  82
  83
  84 (defmethod semanticdb-check-references ((dbt semanticdb-table))
  85   "Check and cleanup references in the database DBT.
  86 Any reference to a file that cannot be found, or whos file no longer
  87 refers to DBT will be removed."
  88   (let ((refs (oref dbt db-refs))
  89         (myexpr (concat "\\<" (oref dbt file)))
  90         )
  91     (while refs
  92       (let* ((ok t)
  93              (db (car refs))
  94              (f (when (semanticdb-table-child-p db)
  95                   (semanticdb-full-filename db)))
  96              )
  97
  98         ;; The file was deleted
  99         (when (and f (not (file-exists-p f)))
 100           (setq ok nil))
 101
 102         ;; The reference no longer includes the textual reference?
 103         (let* ((refs (semanticdb-includes-in-table db))
 104                (inc (semantic-find-tags-by-name-regexp
 105                      myexpr refs)))
 106           (when (not inc)
 107             (setq ok nil)))
 108
 109         ;; Remove not-ok databases from the list.
 110         (when (not ok)
 111           (object-remove-from-list dbt 'db-refs db)
 112           ))
 113       (setq refs (cdr refs)))))
 114
 115 (defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
 116   "Refresh references to DBT in other files."
 117   ;; alternate tables can't be edited, so can't be changed.
 118   nil
 119   )
 120
 121 (defmethod semanticdb-refresh-references ((dbt semanticdb-table))
 122   "Refresh references to DBT in other files."
 123   (let ((refs (semanticdb-includes-in-table dbt))
 124         )
 125     (while refs
 126       (if (semanticdb-add-reference dbt (car refs))
 127           nil
 128         ;; If we succeeded, then do... nothing?
 129         nil
 130         )
 131       (setq refs (cdr refs)))
 132     ))
 133
 134 (defmethod semanticdb-notify-references ((dbt semanticdb-table)
 135                                          method)
 136   "Notify all references of the table DBT using method.
 137 METHOD takes two arguments.
 138   (METHOD TABLE-TO-NOTIFY DBT)
 139 TABLE-TO-NOTIFY is a semanticdb-table which is being notified.
 140 DBT, the second argument is DBT."
 141   (mapc (lambda (R) (funcall method R dbt))
 142           (oref dbt db-refs)))
 143
 144 ;;; DEBUG
 145 ;;
 146 (defclass semanticdb-ref-adebug ()
 147   ((i-depend-on :initarg :i-depend-on)
 148    (local-table :initarg :local-table)
 149    (i-include :initarg :i-include))
 150   "Simple class to allow ADEBUG to show a nice list.")
 151
 152 (defvar semanticdb-current-table)
 153 (declare-function data-debug-new-buffer "data-debug")
 154 (declare-function data-debug-insert-object-slots "eieio-datadebug")
 155
 156 (defun semanticdb-ref-test (refresh)
 157   "Dump out the list of references for the current buffer.
 158 If REFRESH is non-nil, cause the current table to have it's references
 159 refreshed before dumping the result."
 160   (interactive "p")
 161   (require 'eieio-datadebug)
 162   ;; If we need to refresh... then do so.
 163   (when refresh
 164     (semanticdb-refresh-references semanticdb-current-table))
 165   ;; Do the debug system
 166   (let* ((tab semanticdb-current-table)
 167          (myrefs (oref tab db-refs))
 168          (myinc (semanticdb-includes-in-table tab))
 169          (adbc (semanticdb-ref-adebug "DEBUG"
 170                                       :i-depend-on myrefs
 171                                       :local-table tab
 172                                       :i-include myinc)))
 173     (data-debug-new-buffer "*References ADEBUG*")
 174     (data-debug-insert-object-slots adbc "!"))
 175   )
 176
 177 (provide 'semantic/db-ref)
 178 ;;; semantic/db-ref.el ends here