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