lisp/cedet/semantic/db-ref.el

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