lisp/cedet/semantic/db-ref.el

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