summaryrefslogtreecommitdiff
path: root/lisp/cedet/semantic/db-ref.el
blob: 10108d39772052599200cd3fcfd586b647fa406c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
;;; semantic/db-ref.el --- Handle cross-db file references  -*- lexical-binding: t; -*-

;; Copyright (C) 2007-2021  Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <zappo@gnu.org>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Handle cross-database file references.
;;
;; Any given database may be referred to by some other database.  For
;; example, if a .cpp file has a #include in a header, then that
;; header file should have a reference to the .cpp file that included
;; it.
;;
;; This is critical for purposes where a file (such as a .cpp file)
;; needs to have its caches flushed because of changes in the
;; header.  Changing a header may cause a referring file to be
;; reparsed due to account for changes in defined macros, or perhaps
;; a change to files the header includes.


;;; Code:
(require 'eieio)
(require 'cl-generic)
(require 'semantic)
(require 'semantic/db)
(require 'semantic/tag)

;; For the semantic-find-tags-by-name-regexp macro.
(eval-when-compile (require 'semantic/find))

(cl-defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
				     include-tag)
  "Add a reference for the database table DBT based on INCLUDE-TAG.
DBT is the database table that owns the INCLUDE-TAG.  The reference
will be added to the database that INCLUDE-TAG refers to."
  ;; NOTE: I should add a check to make sure include-tag is in DB.
  ;;       but I'm too lazy.
  (let* ((semanticdb-find-default-throttle
	       (if (featurep 'semantic/db-find)
		   (remq 'unloaded semanticdb-find-default-throttle)
		 nil))
	 (refdbt (semanticdb-find-table-for-include include-tag dbt))
	 ;;(fullfile (semanticdb-full-filename dbt))
	 )
    (when refdbt
      ;; Add our filename (full path)
      ;; (object-add-to-list refdbt 'file-refs fullfile)

      ;; Add our database.
      (object-add-to-list refdbt 'db-refs dbt)
      t)))

(cl-defmethod semanticdb-check-references ((_dbt semanticdb-abstract-table))
  "Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference."
  ;; Not sure how an abstract table can have references.
  nil)

(cl-defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
  "Return a list of direct includes in table DBT."
  (semantic-find-tags-by-class 'include (semanticdb-get-tags dbt)))


(cl-defmethod semanticdb-check-references ((dbt semanticdb-table))
  "Check and cleanup references in the database DBT.
Any reference to a file that cannot be found, or whose file no longer
refers to DBT will be removed."
  (let ((refs (oref dbt db-refs))
	(myexpr (concat "\\<" (oref dbt file)))
	)
    (while refs
      (let* ((ok t)
	     (db (car refs))
	     (f (when (cl-typep db 'semanticdb-table)
		  (semanticdb-full-filename db)))
	     )

	;; The file was deleted
	(when (and f (not (file-exists-p f)))
	  (setq ok nil))

	;; The reference no longer includes the textual reference?
	(let* ((refs (semanticdb-includes-in-table db))
	       (inc (semantic-find-tags-by-name-regexp
		     myexpr refs)))
	  (when (not inc)
	    (setq ok nil)))

	;; Remove not-ok databases from the list.
	(when (not ok)
	  (object-remove-from-list dbt 'db-refs db)
	  ))
      (setq refs (cdr refs)))))

(cl-defmethod semanticdb-refresh-references ((_dbt semanticdb-abstract-table))
  "Refresh references to DBT in other files."
  ;; alternate tables can't be edited, so can't be changed.
  nil
  )

(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-table))
  "Refresh references to DBT in other files."
  (let ((refs (semanticdb-includes-in-table dbt))
	)
    (while refs
      (if (semanticdb-add-reference dbt (car refs))
	  nil
	;; If we succeeded, then do... nothing?
	nil
	)
      (setq refs (cdr refs)))
    ))

(cl-defmethod semanticdb-notify-references ((dbt semanticdb-table)
					 method)
  "Notify all references of the table DBT using method.
METHOD takes two arguments.
  (METHOD TABLE-TO-NOTIFY DBT)
TABLE-TO-NOTIFY is a semanticdb-table which is being notified.
DBT, the second argument is DBT."
  (mapc (lambda (R) (funcall method R dbt))
	  (oref dbt db-refs)))

;;; DEBUG
;;
(defclass semanticdb-ref-adebug ()
  ((i-depend-on :initarg :i-depend-on)
   (local-table :initarg :local-table)
   (i-include :initarg :i-include))
  "Simple class to allow ADEBUG to show a nice list.")

(declare-function data-debug-new-buffer "data-debug")
(declare-function data-debug-insert-object-slots "eieio-datadebug")

(defun semanticdb-ref-test (refresh)
  "Dump out the list of references for the current buffer.
If REFRESH is non-nil, cause the current table to have its references
refreshed before dumping the result."
  (interactive "p")
  (require 'eieio-datadebug)
  ;; If we need to refresh... then do so.
  (when refresh
    (semanticdb-refresh-references semanticdb-current-table))
  ;; Do the debug system
  (let* ((tab semanticdb-current-table)
	 (myrefs (oref tab db-refs))
	 (myinc (semanticdb-includes-in-table tab))
	 (adbc (semanticdb-ref-adebug :i-depend-on myrefs
				      :local-table tab
				      :i-include myinc)))
    (data-debug-new-buffer "*References ADEBUG*")
    (data-debug-insert-object-slots adbc "!"))
  )

(provide 'semantic/db-ref)

;;; semantic/db-ref.el ends here