Commit | Line | Data |
---|---|---|
691a065e | 1 | ;;; semantic/db.el --- Semantic tag database manager |
7a0e7d33 CY |
2 | |
3 | ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, | |
4 | ;;; 2008, 2009 Free Software Foundation, Inc. | |
5 | ||
6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 | ;; Keywords: tags | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ;; | |
26 | ;; Maintain a database of tags for a group of files and enable | |
27 | ;; queries into the database. | |
28 | ;; | |
29 | ;; By default, assume one database per directory. | |
30 | ;; | |
31 | ||
32 | (require 'eieio) | |
33 | ;; (require 'inversion) | |
34 | ;; (eval-and-compile | |
35 | ;; (inversion-require 'eieio "1.0")) | |
36 | (require 'eieio-base) | |
37 | (require 'semantic) | |
38 | (eval-when-compile | |
39 | (require 'semantic/lex-spp)) | |
40 | ||
41 | ;;; Variables: | |
42 | (defgroup semanticdb nil | |
43 | "Parser Generator Persistent Database interface." | |
44 | :group 'semantic | |
45 | ) | |
46 | ;;; Code: | |
47 | (defvar semanticdb-database-list nil | |
48 | "List of all active databases.") | |
49 | ||
50 | (defvar semanticdb-new-database-class 'semanticdb-project-database-file | |
51 | "The default type of database created for new files. | |
52 | This can be changed on a per file basis, so that some directories | |
53 | are saved using one mechanism, and some directories via a different | |
54 | mechanism.") | |
55 | (make-variable-buffer-local 'semanticdb-new-database-class) | |
56 | ||
57 | (defvar semanticdb-default-find-index-class 'semanticdb-find-search-index | |
58 | "The default type of search index to use for a `semanticdb-table's. | |
59 | This can be changed to try out new types of search indicies.") | |
60 | (make-variable-buffer-local 'semanticdb-default-find=index-class) | |
61 | ||
691a065e CY |
62 | (defvar semanticdb-current-database nil |
63 | "For a given buffer, this is the currently active database.") | |
64 | (make-variable-buffer-local 'semanticdb-current-database) | |
65 | ||
66 | (defvar semanticdb-current-table nil | |
67 | "For a given buffer, this is the currently active database table.") | |
68 | (make-variable-buffer-local 'semanticdb-current-table) | |
7a0e7d33 CY |
69 | |
70 | ;;; ABSTRACT CLASSES | |
71 | ;; | |
72 | (defclass semanticdb-abstract-table () | |
73 | ((parent-db ;; :initarg :parent-db | |
74 | ;; Do not set an initarg, or you get circular writes to disk. | |
75 | :documentation "Database Object containing this table.") | |
76 | (major-mode :initarg :major-mode | |
77 | :initform nil | |
78 | :documentation "Major mode this table belongs to. | |
79 | Sometimes it is important for a program to know if a given table has the | |
80 | same major mode as the current buffer.") | |
81 | (tags :initarg :tags | |
82 | :accessor semanticdb-get-tags | |
83 | :printer semantic-tag-write-list-slot-value | |
84 | :documentation "The tags belonging to this table.") | |
85 | (index :type semanticdb-abstract-search-index | |
86 | :documentation "The search index. | |
87 | Used by semanticdb-find to store additional information about | |
88 | this table for searching purposes. | |
89 | ||
90 | Note: This index will not be saved in a persistent file.") | |
91 | (cache :type list | |
92 | :initform nil | |
93 | :documentation "List of cache information for tools. | |
94 | Any particular tool can cache data to a database at runtime | |
95 | with `semanticdb-cache-get'. | |
96 | ||
97 | Using a semanticdb cache does not save any information to a file, | |
98 | so your cache will need to be recalculated at runtime. Caches can be | |
99 | referenced even when the file is not in a buffer. | |
100 | ||
101 | Note: This index will not be saved in a persistent file.") | |
102 | ) | |
103 | "A simple table for semantic tags. | |
104 | This table is the root of tables, and contains the minimum needed | |
105 | for a new table not associated with a buffer." | |
106 | :abstract t) | |
107 | ||
108 | (defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table)) | |
109 | "Return a nil, meaning abstract table OBJ is not in a buffer." | |
110 | nil) | |
111 | ||
112 | (defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table)) | |
113 | "Return a buffer associated with OBJ. | |
114 | If the buffer is not in memory, load it with `find-file-noselect'." | |
115 | nil) | |
116 | ||
117 | (defmethod semanticdb-full-filename ((obj semanticdb-abstract-table)) | |
118 | "Fetch the full filename that OBJ refers to. | |
119 | Abstract tables do not have file names associated with them." | |
120 | nil) | |
121 | ||
122 | (defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table)) | |
123 | "Return non-nil if OBJ is 'dirty'." | |
124 | nil) | |
125 | ||
126 | (defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table)) | |
127 | "Mark the abstract table OBJ dirty. | |
128 | Abstract tables can not be marked dirty, as there is nothing | |
129 | for them to synchronize against." | |
130 | ;; The abstract table can not be dirty. | |
131 | nil) | |
132 | ||
133 | (defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags) | |
134 | "For the table OBJ, convert a list of TAGS, into standardized form. | |
135 | The default is to return TAGS. | |
136 | Some databases may default to searching and providing simplified tags | |
137 | based on whichever technique used. This method provides a hook for | |
138 | them to convert TAG into a more complete form." | |
139 | tags) | |
140 | ||
141 | (defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag) | |
142 | "For the table OBJ, convert a TAG, into standardized form. | |
143 | This method returns a list of the form (DATABASE . NEWTAG). | |
144 | ||
145 | The default is to just return (OBJ TAG). | |
146 | ||
147 | Some databases may default to searching and providing simplified tags | |
148 | based on whichever technique used. This method provides a hook for | |
149 | them to convert TAG into a more complete form." | |
150 | (cons obj tag)) | |
151 | ||
152 | (defmethod object-print ((obj semanticdb-abstract-table) &rest strings) | |
153 | "Pretty printer extension for `semanticdb-table'. | |
154 | Adds the number of tags in this file to the object print name." | |
155 | (apply 'call-next-method obj | |
156 | (cons (format " (%d tags)" | |
157 | (length (semanticdb-get-tags obj)) | |
158 | ) | |
159 | strings))) | |
160 | ||
691a065e CY |
161 | (defclass semanticdb-search-results-table (semanticdb-abstract-table) |
162 | ( ) | |
163 | "Table used for search results when there is no file or table association. | |
164 | Examples include search results from external sources such as from | |
165 | Emacs' own symbol table, or from external libraries.") | |
166 | ||
167 | (defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force) | |
168 | "If the tag list associated with OBJ is loaded, refresh it. | |
169 | This will call `semantic-fetch-tags' if that file is in memory." | |
170 | nil) | |
171 | ||
7a0e7d33 CY |
172 | ;;; Index Cache |
173 | ;; | |
174 | (defclass semanticdb-abstract-search-index () | |
175 | ((table :initarg :table | |
176 | :type semanticdb-abstract-table | |
177 | :documentation "XRef to the table this belongs to.") | |
178 | ) | |
179 | "A place where semanticdb-find can store search index information. | |
180 | The search index will store data about which other tables might be | |
181 | needed, or perhaps create hash or index tables for the current buffer." | |
182 | :abstract t) | |
183 | ||
184 | (defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table)) | |
185 | "Return the search index for the table OBJ. | |
186 | If one doesn't exist, create it." | |
187 | (if (slot-boundp obj 'index) | |
188 | (oref obj index) | |
189 | (let ((idx nil)) | |
190 | (setq idx (funcall semanticdb-default-find-index-class | |
191 | (concat (object-name obj) " index") | |
192 | ;; Fill in the defaults | |
193 | :table obj | |
194 | )) | |
195 | (oset obj index idx) | |
196 | idx))) | |
197 | ||
198 | (defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index) | |
199 | new-tags) | |
200 | "Synchronize the search index IDX with some NEW-TAGS." | |
201 | ;; The abstract class will do... NOTHING! | |
202 | ) | |
203 | ||
204 | (defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index) | |
205 | new-tags) | |
206 | "Synchronize the search index IDX with some changed NEW-TAGS." | |
207 | ;; The abstract class will do... NOTHING! | |
208 | ) | |
209 | ||
210 | ||
211 | ;;; CONCRETE TABLE CLASSES | |
212 | ;; | |
213 | (defclass semanticdb-table (semanticdb-abstract-table) | |
214 | ((file :initarg :file | |
215 | :documentation "File name relative to the parent database. | |
216 | This is for the file whose tags are stored in this TABLE object.") | |
217 | (buffer :initform nil | |
218 | :documentation "The buffer associated with this table. | |
219 | If nil, the table's buffer is no in Emacs. If it has a value, then | |
220 | it is in Emacs.") | |
221 | (dirty :initform nil | |
222 | :documentation | |
223 | "Non nil if this table needs to be `Saved'.") | |
224 | (db-refs :initform nil | |
225 | :documentation | |
226 | "List of `semanticdb-table' objects refering to this one. | |
227 | These aren't saved, but are instead recalculated after load. | |
228 | See the file semanticdb-ref.el for how this slot is used.") | |
229 | (pointmax :initarg :pointmax | |
230 | :initform nil | |
231 | :documentation "Size of buffer when written to disk. | |
232 | Checked on retrieval to make sure the file is the same.") | |
233 | (fsize :initarg :fsize | |
234 | :initform nil | |
235 | :documentation "Size of the file when it was last referenced. | |
236 | Checked when deciding if a loaded table needs updating from changes | |
237 | outside of Semantic's control.") | |
238 | (lastmodtime :initarg :lastmodtime | |
239 | :initform nil | |
240 | :documentation "Last modification time of the file referenced. | |
241 | Checked when deciding if a loaded table needs updating from changes outside of | |
242 | Semantic's control.") | |
243 | ;; @todo - need to add `last parsed time', so we can also have | |
244 | ;; refresh checks if spp tables or the parser gets rebuilt. | |
245 | (unmatched-syntax :initarg :unmatched-syntax | |
246 | :documentation | |
247 | "List of vectors specifying unmatched syntax.") | |
248 | ||
249 | (lexical-table :initarg :lexical-table | |
250 | :initform nil | |
251 | :printer semantic-lex-spp-table-write-slot-value | |
252 | :documentation | |
253 | "Table that might be needed by the lexical analyzer. | |
254 | For C/C++, the C preprocessor macros can be saved here.") | |
255 | ) | |
256 | "A single table of tags derived from file.") | |
257 | ||
258 | (defmethod semanticdb-in-buffer-p ((obj semanticdb-table)) | |
259 | "Return a buffer associated with OBJ. | |
260 | If the buffer is in memory, return that buffer." | |
261 | (let ((buff (oref obj buffer))) | |
262 | (if (buffer-live-p buff) | |
263 | buff | |
264 | (oset obj buffer nil)))) | |
265 | ||
266 | (defmethod semanticdb-get-buffer ((obj semanticdb-table)) | |
267 | "Return a buffer associated with OBJ. | |
268 | If the buffer is in memory, return that buffer. | |
269 | If the buffer is not in memory, load it with `find-file-noselect'." | |
270 | (or (semanticdb-in-buffer-p obj) | |
271 | (find-file-noselect (semanticdb-full-filename obj) t))) | |
272 | ||
273 | (defmethod semanticdb-set-buffer ((obj semanticdb-table)) | |
274 | "Set the current buffer to be a buffer owned by OBJ. | |
275 | If OBJ's file is not loaded, read it in first." | |
276 | (set-buffer (semanticdb-get-buffer obj))) | |
277 | ||
278 | (defmethod semanticdb-full-filename ((obj semanticdb-table)) | |
279 | "Fetch the full filename that OBJ refers to." | |
280 | (expand-file-name (oref obj file) | |
281 | (oref (oref obj parent-db) reference-directory))) | |
282 | ||
283 | (defmethod semanticdb-dirty-p ((obj semanticdb-table)) | |
284 | "Return non-nil if OBJ is 'dirty'." | |
285 | (oref obj dirty)) | |
286 | ||
287 | (defmethod semanticdb-set-dirty ((obj semanticdb-table)) | |
288 | "Mark the abstract table OBJ dirty." | |
289 | (oset obj dirty t) | |
290 | ) | |
291 | ||
292 | (defmethod object-print ((obj semanticdb-table) &rest strings) | |
293 | "Pretty printer extension for `semanticdb-table'. | |
294 | Adds the number of tags in this file to the object print name." | |
295 | (apply 'call-next-method obj | |
296 | (cons (if (oref obj dirty) ", DIRTY" "") strings))) | |
297 | ||
298 | ;;; DATABASE BASE CLASS | |
299 | ;; | |
300 | (defclass semanticdb-project-database (eieio-instance-tracker) | |
301 | ((tracking-symbol :initform semanticdb-database-list) | |
302 | (reference-directory :type string | |
303 | :documentation "Directory this database refers to. | |
304 | When a cache directory is specified, then this refers to the directory | |
305 | this database contains symbols for.") | |
306 | (new-table-class :initform semanticdb-table | |
307 | :type class | |
308 | :documentation | |
309 | "New tables created for this database are of this class.") | |
310 | (cache :type list | |
311 | :initform nil | |
312 | :documentation "List of cache information for tools. | |
313 | Any particular tool can cache data to a database at runtime | |
314 | with `semanticdb-cache-get'. | |
315 | ||
316 | Using a semanticdb cache does not save any information to a file, | |
317 | so your cache will need to be recalculated at runtime. | |
318 | ||
319 | Note: This index will not be saved in a persistent file.") | |
320 | (tables :initarg :tables | |
321 | :type list | |
322 | ;; Need this protection so apps don't try to access | |
323 | ;; the tables without using the accessor. | |
324 | :accessor semanticdb-get-database-tables | |
325 | :protection :protected | |
326 | :documentation "List of `semantic-db-table' objects.")) | |
327 | "Database of file tables.") | |
328 | ||
329 | (defmethod semanticdb-full-filename ((obj semanticdb-project-database)) | |
330 | "Fetch the full filename that OBJ refers to. | |
331 | Abstract tables do not have file names associated with them." | |
332 | nil) | |
333 | ||
334 | (defmethod semanticdb-dirty-p ((DB semanticdb-project-database)) | |
335 | "Return non-nil if DB is 'dirty'. | |
336 | A database is dirty if the state of the database changed in a way | |
337 | where it may need to resynchronize with some persistent storage." | |
338 | (let ((dirty nil) | |
339 | (tabs (oref DB tables))) | |
340 | (while (and (not dirty) tabs) | |
341 | (setq dirty (semanticdb-dirty-p (car tabs))) | |
342 | (setq tabs (cdr tabs))) | |
343 | dirty)) | |
344 | ||
345 | (defmethod object-print ((obj semanticdb-project-database) &rest strings) | |
346 | "Pretty printer extension for `semanticdb-project-database'. | |
347 | Adds the number of tables in this file to the object print name." | |
348 | (apply 'call-next-method obj | |
349 | (cons (format " (%d tables%s)" | |
350 | (length (semanticdb-get-database-tables obj)) | |
351 | (if (semanticdb-dirty-p obj) | |
352 | " DIRTY" "") | |
353 | ) | |
354 | strings))) | |
355 | ||
356 | (defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory) | |
357 | "Create a new semantic database of class DBC for DIRECTORY and return it. | |
358 | If a database for DIRECTORY has already been created, return it. | |
359 | If DIRECTORY doesn't exist, create a new one." | |
360 | (let ((db (semanticdb-directory-loaded-p directory))) | |
361 | (unless db | |
362 | (setq db (semanticdb-project-database | |
363 | (file-name-nondirectory directory) | |
364 | :tables nil)) | |
365 | ;; Set this up here. We can't put it in the constructor because it | |
366 | ;; would be saved, and we want DB files to be portable. | |
367 | (oset db reference-directory (file-truename directory))) | |
368 | db)) | |
369 | ||
370 | (defmethod semanticdb-flush-database-tables ((db semanticdb-project-database)) | |
371 | "Reset the tables in DB to be empty." | |
372 | (oset db tables nil)) | |
373 | ||
374 | (defmethod semanticdb-create-table ((db semanticdb-project-database) file) | |
375 | "Create a new table in DB for FILE and return it. | |
376 | The class of DB contains the class name for the type of table to create. | |
377 | If the table for FILE exists, return it. | |
378 | If the table for FILE does not exist, create one." | |
379 | (let ((newtab (semanticdb-file-table db file))) | |
380 | (unless newtab | |
381 | ;; This implementation will satisfy autoloaded classes | |
382 | ;; for tables. | |
383 | (setq newtab (funcall (oref db new-table-class) | |
384 | (file-name-nondirectory file) | |
385 | :file (file-name-nondirectory file) | |
386 | )) | |
387 | (oset newtab parent-db db) | |
388 | (object-add-to-list db 'tables newtab t)) | |
389 | newtab)) | |
390 | ||
391 | (defmethod semanticdb-file-table ((obj semanticdb-project-database) filename) | |
392 | "From OBJ, return FILENAME's associated table object." | |
393 | (object-assoc (file-relative-name (file-truename filename) | |
394 | (oref obj reference-directory)) | |
395 | 'file (oref obj tables))) | |
396 | ||
397 | ;; DATABASE FUNCTIONS | |
398 | (defun semanticdb-get-database (filename) | |
399 | "Get a database for FILENAME. | |
400 | If one isn't found, create one." | |
401 | (semanticdb-create-database semanticdb-new-database-class (file-truename filename))) | |
402 | ||
403 | (defun semanticdb-directory-loaded-p (path) | |
404 | "Return the project belonging to PATH if it was already loaded." | |
405 | (eieio-instance-tracker-find path 'reference-directory 'semanticdb-database-list)) | |
406 | ||
407 | (defun semanticdb-create-table-for-file (filename) | |
408 | "Initialize a database table for FILENAME, and return it. | |
409 | If FILENAME exists in the database already, return that. | |
410 | If there is no database for the table to live in, create one." | |
411 | (let ((cdb nil) | |
412 | (tbl nil) | |
413 | (dd (file-name-directory filename)) | |
414 | ) | |
415 | ;; Allow a database override function | |
416 | (setq cdb (semanticdb-create-database semanticdb-new-database-class | |
417 | dd)) | |
418 | ;; Get a table for this file. | |
419 | (setq tbl (semanticdb-create-table cdb filename)) | |
420 | ||
421 | ;; Return the pair. | |
422 | (cons cdb tbl) | |
423 | )) | |
424 | ||
425 | ;;; Cache Cache. | |
426 | ;; | |
427 | (defclass semanticdb-abstract-cache () | |
428 | ((table :initarg :table | |
429 | :type semanticdb-abstract-table | |
430 | :documentation | |
431 | "Cross reference to the table this belongs to.") | |
432 | ) | |
433 | "Abstract baseclass for tools to use to cache information in semanticdb. | |
434 | Tools needing a per-file cache must subclass this, and then get one as | |
435 | needed. Cache objects are identified in semanticdb by subclass. | |
436 | In order to keep your cache up to date, be sure to implement | |
437 | `semanticdb-synchronize', and `semanticdb-partial-synchronize'. | |
438 | See the file semantic-scope.el for an example." | |
439 | :abstract t) | |
440 | ||
441 | (defmethod semanticdb-cache-get ((table semanticdb-abstract-table) | |
442 | desired-class) | |
443 | "Get a cache object on TABLE of class DESIRED-CLASS. | |
444 | This method will create one if none exists with no init arguments | |
445 | other than :table." | |
446 | (assert (child-of-class-p desired-class 'semanticdb-abstract-cache)) | |
447 | (let ((cache (oref table cache)) | |
448 | (obj nil)) | |
449 | (while (and (not obj) cache) | |
450 | (if (eq (object-class-fast (car cache)) desired-class) | |
451 | (setq obj (car cache))) | |
452 | (setq cache (cdr cache))) | |
453 | (if obj | |
454 | obj ;; Just return it. | |
455 | ;; No object, lets create a new one and return that. | |
456 | (setq obj (funcall desired-class "Cache" :table table)) | |
457 | (object-add-to-list table 'cache obj) | |
458 | obj))) | |
459 | ||
460 | (defmethod semanticdb-cache-remove ((table semanticdb-abstract-table) | |
461 | cache) | |
462 | "Remove from TABLE the cache object CACHE." | |
463 | (object-remove-from-list table 'cache cache)) | |
464 | ||
465 | (defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache) | |
466 | new-tags) | |
467 | "Synchronize a CACHE with some NEW-TAGS." | |
468 | ;; The abstract class will do... NOTHING! | |
469 | ) | |
470 | ||
471 | (defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache) | |
472 | new-tags) | |
473 | "Synchronize a CACHE with some changed NEW-TAGS." | |
474 | ;; The abstract class will do... NOTHING! | |
475 | ) | |
476 | ||
477 | (defclass semanticdb-abstract-db-cache () | |
478 | ((db :initarg :db | |
479 | :type semanticdb-project-database | |
480 | :documentation | |
481 | "Cross reference to the database this belongs to.") | |
482 | ) | |
483 | "Abstract baseclass for tools to use to cache information in semanticdb. | |
484 | Tools needing a database cache must subclass this, and then get one as | |
485 | needed. Cache objects are identified in semanticdb by subclass. | |
486 | In order to keep your cache up to date, be sure to implement | |
487 | `semanticdb-synchronize', and `semanticdb-partial-synchronize'. | |
488 | See the file semantic-scope.el for an example." | |
489 | :abstract t) | |
490 | ||
491 | (defmethod semanticdb-cache-get ((db semanticdb-project-database) | |
492 | desired-class) | |
493 | "Get a cache object on DB of class DESIRED-CLASS. | |
494 | This method will create one if none exists with no init arguments | |
495 | other than :table." | |
496 | (assert (child-of-class-p desired-class 'semanticdb-abstract-db-cache)) | |
497 | (let ((cache (oref db cache)) | |
498 | (obj nil)) | |
499 | (while (and (not obj) cache) | |
500 | (if (eq (object-class-fast (car cache)) desired-class) | |
501 | (setq obj (car cache))) | |
502 | (setq cache (cdr cache))) | |
503 | (if obj | |
504 | obj ;; Just return it. | |
505 | ;; No object, lets create a new one and return that. | |
506 | (setq obj (funcall desired-class "Cache" :db db)) | |
507 | (object-add-to-list db 'cache obj) | |
508 | obj))) | |
509 | ||
510 | (defmethod semanticdb-cache-remove ((db semanticdb-project-database) | |
511 | cache) | |
512 | "Remove from TABLE the cache object CACHE." | |
513 | (object-remove-from-list db 'cache cache)) | |
514 | ||
515 | ||
516 | (defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache) | |
517 | new-tags) | |
518 | "Synchronize a CACHE with some NEW-TAGS." | |
519 | ;; The abstract class will do... NOTHING! | |
520 | ) | |
521 | ||
522 | (defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache) | |
523 | new-tags) | |
524 | "Synchronize a CACHE with some changed NEW-TAGS." | |
525 | ;; The abstract class will do... NOTHING! | |
526 | ) | |
527 | ||
528 | ;;; REFRESH | |
529 | ||
530 | (defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force) | |
531 | "If the tag list associated with OBJ is loaded, refresh it. | |
532 | Optional argument FORCE will force a refresh even if the file in question | |
533 | is not in a buffer. Avoid using FORCE for most uses, as an old cache | |
534 | may be sufficient for the general case. Forced updates can be slow. | |
535 | This will call `semantic-fetch-tags' if that file is in memory." | |
536 | (when (or (semanticdb-in-buffer-p obj) force) | |
537 | (save-excursion | |
538 | (semanticdb-set-buffer obj) | |
539 | (semantic-fetch-tags)))) | |
540 | ||
541 | (defmethod semanticdb-needs-refresh-p ((obj semanticdb-table)) | |
542 | "Return non-nil of OBJ's tag list is out of date. | |
543 | The file associated with OBJ does not need to be in a buffer." | |
544 | (let* ((ff (semanticdb-full-filename obj)) | |
545 | (buff (semanticdb-in-buffer-p obj)) | |
546 | ) | |
547 | (if buff | |
548 | (save-excursion | |
549 | (set-buffer buff) | |
550 | ;; Use semantic's magic tracker to determine of the buffer is up | |
551 | ;; to date or not. | |
552 | (not (semantic-parse-tree-up-to-date-p)) | |
553 | ;; We assume that semanticdb is keeping itself up to date. | |
554 | ;; via all the clever hooks | |
555 | ) | |
556 | ;; Buffer isn't loaded. The only clue we have is if the file | |
557 | ;; is somehow different from our mark in the semanticdb table. | |
558 | (let* ((stats (file-attributes ff)) | |
559 | (actualsize (nth 7 stats)) | |
560 | (actualmod (nth 5 stats)) | |
561 | ) | |
562 | ||
563 | (or (not (slot-boundp obj 'tags)) | |
564 | ;; (not (oref obj tags)) --> not needed anymore? | |
565 | (/= (or (oref obj fsize) 0) actualsize) | |
566 | (not (equal (oref obj lastmodtime) actualmod)) | |
567 | ) | |
568 | )))) | |
569 | ||
570 | \f | |
571 | ;;; Synchronization | |
572 | ;; | |
573 | (defmethod semanticdb-synchronize ((table semanticdb-abstract-table) | |
574 | new-tags) | |
575 | "Synchronize the table TABLE with some NEW-TAGS." | |
576 | (oset table tags new-tags) | |
577 | (oset table pointmax (point-max)) | |
578 | (let ((fattr (file-attributes (semanticdb-full-filename table)))) | |
579 | (oset table fsize (nth 7 fattr)) | |
580 | (oset table lastmodtime (nth 5 fattr)) | |
581 | ) | |
582 | ;; Assume it is now up to date. | |
583 | (oset table unmatched-syntax semantic-unmatched-syntax-cache) | |
584 | ;; The lexical table should be good too. | |
585 | (when (featurep 'semantic-lex-spp) | |
586 | (oset table lexical-table (semantic-lex-spp-save-table))) | |
587 | ;; this implies dirtyness | |
588 | (semanticdb-set-dirty table) | |
589 | ||
590 | ;; Synchronize the index | |
591 | (when (slot-boundp table 'index) | |
592 | (let ((idx (oref table index))) | |
593 | (when idx (semanticdb-synchronize idx new-tags)))) | |
594 | ||
595 | ;; Synchronize application caches. | |
596 | (dolist (C (oref table cache)) | |
597 | (semanticdb-synchronize C new-tags) | |
598 | ) | |
599 | ||
600 | ;; Update cross references | |
601 | ;; (semanticdb-refresh-references table) | |
602 | ) | |
603 | ||
604 | (defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table) | |
605 | new-tags) | |
606 | "Synchronize the table TABLE where some NEW-TAGS changed." | |
607 | ;; You might think we need to reset the tags, but since the partial | |
608 | ;; parser splices the lists, we don't need to do anything | |
609 | ;;(oset table tags new-tags) | |
610 | ;; We do need to mark ourselves dirty. | |
611 | (semanticdb-set-dirty table) | |
612 | ||
613 | ;; The lexical table may be modified. | |
614 | (when (featurep 'semantic-lex-spp) | |
615 | (oset table lexical-table (semantic-lex-spp-save-table))) | |
616 | ||
617 | ;; Incremental parser doesn't mokey around with this. | |
618 | (oset table unmatched-syntax semantic-unmatched-syntax-cache) | |
619 | ||
620 | ;; Synchronize the index | |
621 | (when (slot-boundp table 'index) | |
622 | (let ((idx (oref table index))) | |
623 | (when idx (semanticdb-partial-synchronize idx new-tags)))) | |
624 | ||
625 | ;; Synchronize application caches. | |
626 | (dolist (C (oref table cache)) | |
627 | (semanticdb-synchronize C new-tags) | |
628 | ) | |
629 | ||
630 | ;; Update cross references | |
631 | ;;(when (semantic-find-tags-by-class 'include new-tags) | |
632 | ;; (semanticdb-refresh-references table)) | |
633 | ) | |
634 | ||
635 | ;;; SAVE/LOAD | |
636 | ;; | |
637 | (defmethod semanticdb-save-db ((DB semanticdb-project-database) | |
638 | &optional supress-questions) | |
639 | "Cause a database to save itself. | |
640 | The database base class does not save itself persistently. | |
641 | Subclasses could save themselves to a file, or to a database, or other | |
642 | form." | |
643 | nil) | |
644 | ||
645 | (defun semanticdb-save-current-db () | |
646 | "Save the current tag database." | |
647 | (interactive) | |
648 | (message "Saving current tag summaries...") | |
649 | (semanticdb-save-db semanticdb-current-database) | |
650 | (message "Saving current tag summaries...done")) | |
651 | ||
652 | (defun semanticdb-save-all-db () | |
653 | "Save all semantic tag databases." | |
654 | (interactive) | |
655 | (message "Saving tag summaries...") | |
656 | (mapc 'semanticdb-save-db semanticdb-database-list) | |
657 | (message "Saving tag summaries...done")) | |
658 | ||
659 | (defun semanticdb-save-all-db-idle () | |
660 | "Save all semantic tag databases from idle time. | |
661 | Exit the save between databases if there is user input." | |
662 | (semantic-safe "Auto-DB Save: %S" | |
663 | (semantic-exit-on-input 'semanticdb-idle-save | |
664 | (mapc (lambda (db) | |
665 | (semantic-throw-on-input 'semanticdb-idle-save) | |
666 | (semanticdb-save-db db t)) | |
667 | semanticdb-database-list)) | |
668 | )) | |
669 | ||
670 | ;;; Directory Project support | |
671 | ;; | |
672 | (defvar semanticdb-project-predicate-functions nil | |
673 | "List of predicates to try that indicate a directory belongs to a project. | |
674 | This list is used when `semanticdb-persistent-path' contains the value | |
675 | 'project. If the predicate list is nil, then presume all paths are valid. | |
676 | ||
677 | Project Management software (such as EDE and JDE) should add their own | |
678 | predicates with `add-hook' to this variable, and semanticdb will save tag | |
679 | caches in directories controlled by them.") | |
680 | ||
681 | (defmethod semanticdb-write-directory-p ((obj semanticdb-project-database)) | |
682 | "Return non-nil if OBJ should be written to disk. | |
683 | Uses `semanticdb-persistent-path' to determine the return value." | |
684 | nil) | |
685 | ||
686 | ;;; Utilities | |
687 | ;; | |
688 | ;; What is the current database, are two tables of an equivalent mode, | |
689 | ;; and what databases are a part of the same project. | |
690 | (defun semanticdb-current-database () | |
691 | "Return the currently active database." | |
692 | (or semanticdb-current-database | |
693 | (and default-directory | |
694 | (semanticdb-create-database semanticdb-new-database-class | |
695 | default-directory) | |
696 | ) | |
697 | nil)) | |
698 | ||
699 | (defvar semanticdb-match-any-mode nil | |
700 | "Non-nil to temporarilly search any major mode for a tag. | |
701 | If a particular major mode wants to search any mode, put the | |
702 | `semantic-match-any-mode' symbol onto the symbol of that major mode. | |
703 | Do not set the value of this variable permanently.") | |
704 | ||
705 | (defmacro semanticdb-with-match-any-mode (&rest body) | |
706 | "A Semanticdb search occuring withing BODY will search tags in all modes. | |
707 | This temporarilly sets `semanticdb-match-any-mode' while executing BODY." | |
708 | `(let ((semanticdb-match-any-mode t)) | |
709 | ,@body)) | |
710 | (put 'semanticdb-with-match-any-mode 'lisp-indent-function 0) | |
711 | ||
712 | (defmethod semanticdb-equivalent-mode-for-search (table &optional buffer) | |
713 | "Return non-nil if TABLE's mode is equivalent to BUFFER. | |
714 | See `semanticdb-equivalent-mode' for details. | |
715 | This version is used during searches. Major-modes that opt | |
716 | to set the `semantic-match-any-mode' property will be able to search | |
717 | all files of any type." | |
718 | (or (get major-mode 'semantic-match-any-mode) | |
719 | semanticdb-match-any-mode | |
720 | (semanticdb-equivalent-mode table buffer)) | |
721 | ) | |
722 | ||
723 | (defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer) | |
724 | "Return non-nil if TABLE's mode is equivalent to BUFFER. | |
725 | Equivalent modes are specified by by `semantic-equivalent-major-modes' | |
726 | local variable." | |
727 | nil) | |
728 | ||
729 | (defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer) | |
730 | "Return non-nil if TABLE's mode is equivalent to BUFFER. | |
731 | Equivalent modes are specified by by `semantic-equivalent-major-modes' | |
732 | local variable." | |
733 | (save-excursion | |
734 | (if buffer (set-buffer buffer)) | |
735 | (or | |
736 | ;; nil major mode in table means we don't know yet. Assume yes for now? | |
737 | (null (oref table major-mode)) | |
738 | ;; nil means the same as major-mode | |
739 | (and (not semantic-equivalent-major-modes) | |
740 | (mode-local-use-bindings-p major-mode (oref table major-mode))) | |
741 | (and semantic-equivalent-major-modes | |
742 | (member (oref table major-mode) semantic-equivalent-major-modes)) | |
743 | ) | |
744 | )) | |
745 | ||
746 | ||
747 | ;;; Associations | |
748 | ;; | |
749 | ;; These routines determine associations between a file, and multiple | |
750 | ;; associated databases. | |
751 | ||
752 | (defcustom semanticdb-project-roots nil | |
753 | "*List of directories, where each directory is the root of some project. | |
754 | All subdirectories of a root project are considered a part of one project. | |
755 | Values in this string can be overriden by project management programs | |
756 | via the `semanticdb-project-root-functions' variable." | |
757 | :group 'semanticdb | |
758 | :type '(repeat string)) | |
759 | ||
760 | (defvar semanticdb-project-root-functions nil | |
761 | "List of functions used to determine a given directories project root. | |
762 | Functions in this variable can override `semanticdb-project-roots'. | |
763 | Functions set in the variable are given one argument (a directory) and | |
764 | must return a string, (the root directory) or a list of strings (multiple | |
765 | root directories in a more complex system). This variable should be used | |
766 | by project management programs like EDE or JDE.") | |
767 | ||
768 | (defvar semanticdb-project-system-databases nil | |
769 | "List of databases containing system library information. | |
770 | Mode authors can create their own system databases which know | |
771 | detailed information about the system libraries for querying purposes. | |
772 | Put those into this variable as a buffer-local, or mode-local | |
773 | value.") | |
774 | (make-variable-buffer-local 'semanticdb-project-system-databases) | |
775 | ||
776 | (defvar semanticdb-search-system-databases t | |
777 | "Non nil if search routines are to include a system database.") | |
778 | ||
779 | (defun semanticdb-current-database-list (&optional dir) | |
780 | "Return a list of databases associated with the current buffer. | |
781 | If optional argument DIR is non-nil, then use DIR as the starting directory. | |
782 | If this buffer has a database, but doesn't have a project associated | |
783 | with it, return nil. | |
784 | First, it checks `semanticdb-project-root-functions', and if that | |
785 | has no results, it checks `semanticdb-project-roots'. If that fails, | |
786 | it returns the results of function `semanticdb-current-database'. | |
787 | Always append `semanticdb-project-system-databases' if | |
788 | `semanticdb-search-system' is non-nil." | |
789 | (let ((root nil) ; found root directory | |
790 | (dbs nil) ; collected databases | |
791 | (roots semanticdb-project-roots) ;all user roots | |
792 | (dir (file-truename (or dir default-directory))) | |
793 | ) | |
794 | ;; Find the root based on project functions. | |
795 | (setq root (run-hook-with-args-until-success | |
796 | 'semanticdb-project-root-functions | |
797 | dir)) | |
798 | ;; Find roots based on strings | |
799 | (while (and roots (not root)) | |
800 | (let ((r (file-truename (car roots)))) | |
801 | (if (string-match (concat "^" (regexp-quote r)) dir) | |
802 | (setq root r))) | |
803 | (setq roots (cdr roots))) | |
804 | ||
805 | ;; If no roots are found, use this directory. | |
806 | (unless root (setq root dir)) | |
807 | ||
808 | ;; Find databases based on the root directory. | |
809 | (when root | |
810 | ;; The rootlist allows the root functions to possibly | |
811 | ;; return several roots which are in different areas but | |
812 | ;; all apart of the same system. | |
813 | (let ((regexp (concat "^" (regexp-quote root))) | |
814 | (adb semanticdb-database-list) ; all databases | |
815 | ) | |
816 | (while adb | |
817 | ;; I don't like this part, but close enough. | |
818 | (if (and (slot-boundp (car adb) 'reference-directory) | |
819 | (string-match regexp (oref (car adb) reference-directory))) | |
820 | (setq dbs (cons (car adb) dbs))) | |
821 | (setq adb (cdr adb)))) | |
822 | ) | |
823 | ;; Add in system databases | |
824 | (when semanticdb-search-system-databases | |
825 | (setq dbs (nconc dbs semanticdb-project-system-databases))) | |
826 | ;; Return | |
827 | dbs)) | |
828 | ||
829 | \f | |
830 | ;;; Generic Accessor Routines | |
831 | ;; | |
832 | ;; These routines can be used to get at tags in files w/out | |
833 | ;; having to know a lot about semanticDB. | |
834 | (defvar semanticdb-file-table-hash (make-hash-table :test 'equal) | |
835 | "Hash table mapping file names to database tables.") | |
836 | ||
837 | (defun semanticdb-file-table-object-from-hash (file) | |
838 | "Retrieve a DB table from the hash for FILE. | |
839 | Does not use `file-truename'." | |
840 | (gethash file semanticdb-file-table-hash 'no-hit)) | |
841 | ||
842 | (defun semanticdb-file-table-object-put-hash (file dbtable) | |
843 | "For FILE, associate DBTABLE in the hash table." | |
844 | (puthash file dbtable semanticdb-file-table-hash)) | |
845 | ||
846 | (defun semanticdb-file-table-object (file &optional dontload) | |
847 | "Return a semanticdb table belonging to FILE, make it up to date. | |
848 | If file has database tags available in the database, return it. | |
849 | If file does not have tags available, and DONTLOAD is nil, | |
850 | then load the tags for FILE, and create a new table object for it. | |
851 | DONTLOAD does not affect the creation of new database objects." | |
852 | ;; (message "Object Translate: %s" file) | |
853 | (when (file-exists-p file) | |
854 | (let* ((default-directory (file-name-directory file)) | |
855 | (tab (semanticdb-file-table-object-from-hash file)) | |
856 | (fullfile nil)) | |
857 | ||
858 | ;; If it is not in the cache, then extract the more traditional | |
859 | ;; way by getting the database, and finding a table in that database. | |
860 | ;; Once we have a table, add it to the hash. | |
861 | (when (eq tab 'no-hit) | |
862 | (setq fullfile (file-truename file)) | |
863 | (let ((db (or ;; This line will pick up system databases. | |
864 | (semanticdb-directory-loaded-p default-directory) | |
865 | ;; this line will make a new one if needed. | |
866 | (semanticdb-get-database default-directory)))) | |
867 | (setq tab (semanticdb-file-table db fullfile)) | |
868 | (when tab | |
869 | (semanticdb-file-table-object-put-hash file tab) | |
870 | (when (not (string= fullfile file)) | |
871 | (semanticdb-file-table-object-put-hash fullfile tab) | |
872 | )) | |
873 | )) | |
874 | ||
875 | (cond | |
876 | ((and tab | |
877 | ;; Is this in a buffer? | |
878 | ;;(find-buffer-visiting (semanticdb-full-filename tab)) | |
879 | (semanticdb-in-buffer-p tab) | |
880 | ) | |
881 | (save-excursion | |
882 | ;;(set-buffer (find-buffer-visiting (semanticdb-full-filename tab))) | |
883 | (semanticdb-set-buffer tab) | |
884 | (semantic-fetch-tags) | |
885 | ;; Return the table. | |
886 | tab)) | |
887 | ((and tab dontload) | |
888 | ;; If we have table, and we don't want to load it, just return it. | |
889 | tab) | |
890 | ((and tab | |
891 | ;; Is table fully loaded, or just a proxy? | |
892 | (number-or-marker-p (oref tab pointmax)) | |
893 | ;; Is this table up to date with the file? | |
894 | (not (semanticdb-needs-refresh-p tab))) | |
895 | ;; A-ok! | |
896 | tab) | |
897 | ((or (and fullfile (get-file-buffer fullfile)) | |
898 | (get-file-buffer file)) | |
899 | ;; are these two calls this faster than `find-buffer-visiting'? | |
900 | ||
901 | ;; If FILE is being visited, but none of the above state is | |
902 | ;; true (meaning, there is no table object associated with it) | |
903 | ;; then it is a file not supported by Semantic, and can be safely | |
904 | ;; ignored. | |
905 | nil) | |
906 | ((not dontload) ;; We must load the file. | |
907 | ;; Full file should have been set by now. Debug why not? | |
908 | (when (and (not tab) (not fullfile)) | |
909 | ;; This case is if a 'nil is erroneously put into the hash table. This | |
910 | ;; would need fixing | |
911 | (setq fullfile (file-truename file)) | |
912 | ) | |
913 | ||
914 | ;; If we have a table, but no fullfile, that's ok. Lets get the filename | |
915 | ;; from the table which is pre-truenamed. | |
916 | (when (and (not fullfile) tab) | |
917 | (setq fullfile (semanticdb-full-filename tab))) | |
918 | ||
919 | (setq tab (semanticdb-create-table-for-file-not-in-buffer fullfile)) | |
920 | ||
921 | ;; Save the new table. | |
922 | (semanticdb-file-table-object-put-hash file tab) | |
923 | (when (not (string= fullfile file)) | |
924 | (semanticdb-file-table-object-put-hash fullfile tab) | |
925 | ) | |
926 | ;; Done! | |
927 | tab) | |
928 | (t | |
929 | ;; Full file should have been set by now. Debug why not? | |
930 | ;; One person found this. Is it a file that failed to parse | |
931 | ;; in the past? | |
932 | (when (not fullfile) | |
933 | (setq fullfile (file-truename file))) | |
934 | ||
935 | ;; We were asked not to load the file in and parse it. | |
936 | ;; Instead just create a database table with no tags | |
937 | ;; and a claim of being empty. | |
938 | ;; | |
939 | ;; This will give us a starting point for storing | |
940 | ;; database cross-references so when it is loaded, | |
941 | ;; the cross-references will fire and caches will | |
942 | ;; be cleaned. | |
943 | (let ((ans (semanticdb-create-table-for-file file))) | |
944 | (setq tab (cdr ans)) | |
945 | ||
946 | ;; Save the new table. | |
947 | (semanticdb-file-table-object-put-hash file tab) | |
948 | (when (not (string= fullfile file)) | |
949 | (semanticdb-file-table-object-put-hash fullfile tab) | |
950 | ) | |
951 | ;; Done! | |
952 | tab)) | |
953 | ) | |
954 | ))) | |
955 | ||
956 | (defvar semanticdb-out-of-buffer-create-table-fcn nil | |
957 | "When non-nil, a function for creating a semanticdb table. | |
958 | This should take a filename to be parsed.") | |
959 | (make-variable-buffer-local 'semanticdb-out-of-buffer-create-table-fcn) | |
960 | ||
961 | (defun semanticdb-create-table-for-file-not-in-buffer (filename) | |
962 | "Create a table for the file FILENAME. | |
963 | If there are no language specific configurations, this | |
964 | function will read in the buffer, parse it, and kill the buffer." | |
965 | (if (and semanticdb-out-of-buffer-create-table-fcn | |
966 | (not (file-remote-p filename))) | |
967 | ;; Use external parser only of the file is accessible to the | |
968 | ;; local file system. | |
969 | (funcall semanticdb-out-of-buffer-create-table-fcn filename) | |
970 | (save-excursion | |
971 | (let* ( ;; Remember the buffer to kill | |
972 | (kill-buffer-flag (find-buffer-visiting filename)) | |
973 | (buffer-to-kill (or kill-buffer-flag | |
974 | (semantic-find-file-noselect filename t)))) | |
975 | ||
976 | ;; This shouldn't ever be set. Debug some issue here? | |
977 | ;; (when kill-buffer-flag (debug)) | |
978 | ||
979 | (set-buffer buffer-to-kill) | |
980 | ;; Find file should automatically do this for us. | |
981 | ;; Sometimes the DB table doesn't contains tags and needs | |
982 | ;; a refresh. For example, when the file is loaded for | |
983 | ;; the first time, and the idle scheduler didn't get a | |
984 | ;; chance to trigger a parse before the file buffer is | |
985 | ;; killed. | |
986 | (when semanticdb-current-table | |
987 | (semantic-fetch-tags)) | |
988 | (prog1 | |
989 | semanticdb-current-table | |
990 | (when (not kill-buffer-flag) | |
991 | ;; If we had to find the file, then we should kill it | |
992 | ;; to keep the master buffer list clean. | |
993 | (kill-buffer buffer-to-kill) | |
994 | ))))) | |
995 | ) | |
996 | ||
997 | (defun semanticdb-file-stream (file) | |
998 | "Return a list of tags belonging to FILE. | |
999 | If file has database tags available in the database, return them. | |
1000 | If file does not have tags available, then load the file, and create them." | |
1001 | (let ((table (semanticdb-file-table-object file))) | |
1002 | (when table | |
1003 | (semanticdb-get-tags table)))) | |
1004 | ||
1005 | (provide 'semantic/db) | |
1006 | ||
691a065e | 1007 | ;;; semantic/db.el ends here |