1 ;;; semanticdb.el --- Semantic tag database manager
3 ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; X-RCS: $Id: semanticdb.el,v 1.84 2007/05/20 15:56:43 zappo Exp $
9 ;; This file is not part of GNU Emacs.
11 ;; Semanticdb 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 2, or (at your option)
16 ;; This software 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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; Maintain a database of tags for a group of files and enable
29 ;; queries into the database.
31 ;; By default, assume one database per directory.
36 (inversion-require 'eieio "0.18beta1"))
41 (defgroup semanticdb nil
42 "Parser Generator Persistent Database interface."
47 (defcustom semanticdb-global-mode nil
48 "*If non-nil enable the use of `semanticdb-minor-mode'."
52 :initialize 'custom-initialize-default
53 :set (lambda (sym val)
54 (global-semanticdb-minor-mode (if val 1 -1))
55 (custom-set-default sym val)))
57 (defcustom semanticdb-mode-hooks nil
58 "*Hooks run whenever `global-semanticdb-minor-mode' is run.
59 Use `semanticdb-minor-mode-p' to determine if the mode has been turned
64 (defvar semanticdb-database-list nil
65 "List of all active databases.")
67 (defvar semanticdb-semantic-init-hook-overload nil
68 "Semantic init hook overload.
69 Tools wanting to specify the file names of the semantic database
73 (defvar semanticdb-current-database nil
74 "For a given buffer, this is the currently active database.")
75 (make-variable-buffer-local 'semanticdb-current-database)
77 (defvar semanticdb-current-table nil
78 "For a given buffer, this is the currently active database table.")
79 (make-variable-buffer-local 'semanticdb-current-table)
81 (defvar semanticdb-new-database-class 'semanticdb-project-database-file
82 "The default type of database created for new files.
83 This can be changed on a per file basis, so that some directories
84 are saved using one mechanism, and some directories via a different
86 (make-variable-buffer-local 'semanticdb-new-database-class)
89 (defclass semanticdb-abstract-table ()
90 ((parent-db ;; :initarg :parent-db
91 ;; Do not set an initarg, or you get circular writes to disk.
92 :documentation "Database Object containing this table.")
93 (major-mode :initarg :major-mode
95 :documentation "Major mode this table belongs to.
96 Sometimes it is important for a program to know if a given table has the
97 same major mode as the current buffer.")
99 :accessor semanticdb-get-tags
100 :documentation "The tags belonging to this table.")
102 "A simple table for semantic tags.
103 This table is the root of tables, and contains the minimum needed
104 for a new table not associated with a buffer."
107 (defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
108 "Return a buffer associated with OBJ.
109 If the buffer is not in memory, load it with `find-file-noselect'."
112 (defclass semanticdb-table (semanticdb-abstract-table)
113 ((file :initarg :file
114 :documentation "File name relative to the parent database.
115 This is for the file whose tags are stored in this TABLE object.")
116 (pointmax :initarg :pointmax
118 :documentation "Size of buffer when written to disk.
119 Checked on retrieval to make sure the file is the same.")
120 (unmatched-syntax :initarg :unmatched-syntax
122 "List of vectors specifying unmatched syntax.")
124 "A single table of tags derived from file.")
126 (defmethod object-print ((obj semanticdb-table) &rest strings)
127 "Pretty printer extension for `semanticdb-abstract-table'.
128 Adds the number of tags in this file to the object print name."
129 (apply 'call-next-method obj
130 (cons (format " (%d tags)" (length (semanticdb-get-tags obj)))
133 (defclass semanticdb-project-database (eieio-instance-tracker)
134 ((tracking-symbol :initform semanticdb-database-list)
135 (reference-directory :type string
136 :documentation "Directory this database refers to.
137 When a cache directory is specified, then this refers to the directory
138 this database contains symbols for.")
139 (new-table-class :initform semanticdb-table
142 "New tables created for this database are of this class.")
143 (tables :initarg :tables
145 ;; Need this protection so apps don't try to access
146 ;; the tables without using the accessor.
147 :accessor semanticdb-get-database-tables
148 :protection :protected
149 :documentation "List of `semantic-db-table' objects."))
150 "Database of file tables.")
153 (defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory)
154 "Create a new semantic database of class DBC for DIRECTORY and return it.
155 If a database for DIRECTORY has already been created, return it.
156 If DIRECTORY doesn't exist, create a new one."
157 (let ((db (semanticdb-directory-loaded-p directory)))
159 (setq db (semanticdb-project-database
160 (file-name-nondirectory filename)
162 ;; Set this up here. We can't put it in the constructor because it
163 ;; would be saved, and we want DB files to be portable.
164 (oset db reference-directory directory))
167 (defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
168 "Reset the tables in DB to be empty."
169 (oset db tables nil))
171 (defmethod semanticdb-create-table ((db semanticdb-project-database) file)
172 "Create a new table in DB for FILE and return it.
173 The class of DB contains the class name for the type of table to create.
174 If the table for FILE exists, return it.
175 If the table for FILE does not exist, create one."
176 (let ((newtab (semanticdb-file-table db file)))
178 ;; This implementation will satisfy autoloaded classes
180 (setq newtab (funcall (oref db new-table-class)
181 (file-name-nondirectory file)
182 :file (file-name-nondirectory file)
184 (oset newtab parent-db db)
185 (object-add-to-list db 'tables newtab t))
188 (defun semanticdb-get-database (filename)
189 "Get a database for FILENAME.
190 If one isn't found, create one."
191 (semanticdb-create-database semanticdb-new-database-class filename))
193 (defun semanticdb-directory-loaded-p (path)
194 "Return the project belonging to PATH if it was already loaded."
195 (eieio-instance-tracker-find path 'reference-directory 'semanticdb-database-list))
197 (defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
198 "From OBJ, return FILENAME's associated table object."
199 (object-assoc (file-relative-name (expand-file-name filename)
200 (oref obj reference-directory))
201 'file (oref obj tables)))
203 (defmethod semanticdb-get-buffer ((obj semanticdb-table))
204 "Return a buffer associated with OBJ.
205 If the buffer is not in memory, load it with `find-file-noselect'."
206 (find-file-noselect (semanticdb-full-filename obj) t))
208 (defmethod semanticdb-set-buffer ((obj semanticdb-table))
209 "Set the current buffer to be a buffer owned by OBJ.
210 If OBJ's file is not loaded, read it in first."
211 (set-buffer (semanticdb-get-buffer obj)))
213 (defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
214 "For the table OBJ, convert a list of TAGS, into standardized form.
215 The default is to return TAGS.
216 Some databases may default to searching and providing simplified tags
217 based on whichever technique used. This method provides a hook for
218 them to convert TAG into a more complete form."
221 (defmethod semanticdb-refresh-table ((obj semanticdb-table))
222 "If the tag list associated with OBJ is loaded, refresh it.
223 This will call `semantic-fetch-tags' if that file is in memory."
224 (let ((ff (semanticdb-full-filename obj)))
225 (if (get-file-buffer ff)
227 (semanticdb-set-buffer obj)
228 (semantic-fetch-tags)))))
230 (defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
231 "Return non-nil of OBJ's tag list is out of date.
232 The file associated with OBJ does not need to be in a buffer."
233 (let ((buff (get-file-buffer (semanticdb-full-filename obj)))
238 ;; Use semantic's magic tracker to determine of the buffer is up
240 (not (semantic-parse-tree-up-to-date-p))
241 ;; We assume that semanticdb is keeping itself up to date.
242 ;; via all the clever hooks
244 ;; Buffer isn't loaded. The only clue we have is if the file
245 ;; is somehow different from our mark in the semanticdb table.
246 (let* ((stats (file-attributes (semanticdb-full-filename obj)))
247 (actualmax (aref stats 7)))
249 (or (not (slot-boundp obj 'tags))
250 (not (oref obj tags))
251 (/= (or (oref obj pointmax) 0) actualmax)
255 (defmethod semanticdb-save-db ((DB semanticdb-project-database))
256 "Cause a database to save itself.
257 The database base class does not save itself persistently.
258 Subclasses could save themselves to a file, or to a database, or other
262 (defun semanticdb-save-current-db ()
263 "Save the current tag database."
265 (message "Saving current tag summaries...")
266 (semanticdb-save-db semanticdb-current-database)
267 (message "Saving current tag summaries...done"))
269 (defun semanticdb-save-all-db ()
270 "Save all semantic tag databases."
272 (message "Saving tag summaries...")
273 (mapcar 'semanticdb-save-db semanticdb-database-list)
274 (message "Saving tag summaries...done"))
276 ;;; Directory Project support
278 (defvar semanticdb-project-predicate-functions nil
279 "List of predicates to try that indicate a directory belongs to a project.
280 This list is used when `semanticdb-persistent-path' contains the value
281 'project. If the predicate list is nil, then presume all paths are valid.
283 Project Management software (such as EDE and JDE) should add their own
284 predicates with `add-hook' to this variable, and semanticdb will save tag
285 caches in directories controlled by them.")
287 (defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
288 "Return non-nil if OBJ should be written to disk.
289 Uses `semanticdb-persistent-path' to determine the return value."
294 ;; What is the current database, are two tables of an equivalent mode,
295 ;; and what databases are a part of the same project.
297 (defun semanticdb-current-database ()
298 "Return the currently active database."
299 (or semanticdb-current-database
300 (and default-directory
301 (semanticdb-create-database semanticdb-new-database-class
306 (defvar semanticdb-match-any-mode nil
307 "Non-nil to temporarilly search any major mode for a tag.
308 If a particular major mode wants to search any mode, put the
309 `semantic-match-any-mode' symbol onto the symbol of that major mode.
310 Do not set the value of this variable permanently.")
312 (defmacro semanticdb-with-match-any-mode (&rest body)
313 "A Semanticdb search occuring withing BODY will search tags in all modes.
314 This temporarilly sets `semanticdb-match-any-mode' while executing BODY."
315 `(let ((semanticdb-match-any-mode t))
317 (put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
319 (defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
320 "Return non-nil if TABLE's mode is equivalent to BUFFER.
321 See `semanticdb-equivalent-mode' for details.
322 This version is used during searches. Major-modes that opt
323 to set the `semantic-match-any-mode' property will be able to search
324 all files of any type."
325 (or (get major-mode 'semantic-match-any-mode)
326 semanticdb-match-any-mode
327 (semanticdb-equivalent-mode table buffer))
330 (defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
331 "Return non-nil if TABLE's mode is equivalent to BUFFER.
332 Equivalent modes are specified by by `semantic-equivalent-major-modes'
336 (defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
337 "Return non-nil if TABLE's mode is equivalent to BUFFER.
338 Equivalent modes are specified by by `semantic-equivalent-major-modes'
341 (if buffer (set-buffer buffer))
343 ;; nil means the same as major-mode
344 (and (not semantic-equivalent-major-modes)
345 (eq major-mode (oref table major-mode)))
346 (and semantic-equivalent-major-modes
347 (member (oref table major-mode) semantic-equivalent-major-modes))
352 (defmethod semanticdb-printable-name ((table semanticdb-table))
353 "Return a string which is a short and logical printable name for TABLE.
354 Use this instead of getting the :file slot of the table, which can
355 sometimes be unbound."
356 ;; I know I said that the above is sometimes unbound.
357 ;; Not that if this line throws an error, you should go to
358 ;; the subclass, and override this method.
359 (file-name-nondirectory (file-name-sans-extension (oref table file)))
364 ;; These routines determine associations between a file, and multiple
365 ;; associated databases.
367 (defcustom semanticdb-project-roots nil
368 "*List of directories, where each directory is the root of some project.
369 All subdirectories of a root project are considered a part of one project.
370 Values in this string can be overriden by project management programs
371 via the `semanticdb-project-root-functions' variable."
373 :type '(repeat string))
375 (defvar semanticdb-project-root-functions nil
376 "List of functions used to determine a given directories project root.
377 Functions in this variable can override `semanticdb-project-roots'.
378 Functions set in the variable are given one argument (a directory) and
379 must return a string, (the root directory) or a list of strings (multiple
380 root directories in a more complex system). This variable should be used
381 by project management programs like EDE or JDE.")
383 (defvar semanticdb-project-system-databases nil
384 "List of databases containing system library information.
385 Mode authors can create their own system databases which know
386 detailed information about the system libraries for querying purposes.
387 Put those into this variable as a buffer-local, or mode-local
389 (make-variable-buffer-local 'semanticdb-project-system-databases)
391 (defvar semanticdb-search-system-databases t
392 "Non nil if search routines are to include a system database.")
394 (defun semanticdb-current-database-list (&optional dir)
395 "Return a list of databases associated with the current buffer.
396 If optional argument DIR is non-nil, then use DIR as the starting directory.
397 If this buffer has a database, but doesn't have a project associated
399 First, it checks `semanticdb-project-root-functions', and if that
400 has no results, it checks `semanticdb-project-roots'. If that fails,
401 it returns the results of function `semanticdb-current-database'.
402 Always append `semanticdb-project-system-databases' if
403 `semanticdb-search-system' is non-nil."
404 (let ((root nil) ; found root directory
405 (dbs nil) ; collected databases
406 (roots semanticdb-project-roots) ;all user roots
407 (dir (or dir default-directory))
409 ;; Find the root based on project functions.
410 (setq root (run-hook-with-args-until-success
411 'semanticdb-project-root-functions
413 ;; Find roots based on strings
414 (while (and roots (not root))
415 (if (string-match (concat "^"
417 (expand-file-name (car roots))))
418 (expand-file-name dir))
419 (setq root (car roots)))
420 (setq roots (cdr roots)))
422 ;; If no roots are found, use this directory.
423 (unless root (setq root dir))
425 ;; Find databases based on the root directory.
427 ;; The rootlist allows the root functions to possibly
428 ;; return several roots which are in different areas but
429 ;; all apart of the same system.
430 (let ((rootlist (if (listp root) root (list root))))
432 (setq root (car rootlist))
433 (let ((regexp (concat "^" (regexp-quote (expand-file-name root))))
434 (adb semanticdb-database-list) ; all databases
437 ;; I don't like this part, but close enough.
438 (if (and ;; (slot-exists-p (car adb) 'file) <-- What was that for? 2/15/07
439 (slot-boundp (car adb) 'reference-directory)
440 (string-match regexp (oref (car adb) reference-directory)))
441 (setq dbs (cons (car adb) dbs)))
442 (setq adb (cdr adb))))
443 (setq rootlist (cdr rootlist)))))
444 ;; Add in system databases
445 (when semanticdb-search-system-databases
446 (setq dbs (append dbs semanticdb-project-system-databases)))
453 (defun semanticdb-semantic-init-hook-fcn ()
454 "Function saved in `find-file-hooks'.
455 Sets up the semanticdb environment."
458 ;; Allow a database override function
459 (when (not (and semanticdb-semantic-init-hook-overload
460 (setq cdb (run-hooks 'semanticdb-semantic-init-hook-overload))))
461 (setq cdb (semanticdb-create-database semanticdb-new-database-class
464 ;; Get the current DB for this directory
465 (setq semanticdb-current-database cdb)
466 ;; Get a table for this file.
467 (setq ctbl (semanticdb-create-table cdb (buffer-file-name)))
468 ;; We set the major mode because we know what it is.
469 (oset ctbl major-mode major-mode)
471 (setq semanticdb-current-table ctbl)
472 ;; Try to swap in saved tags
473 (if (or (not (slot-boundp ctbl 'tags)) (not (oref ctbl tags))
474 (/= (or (oref ctbl pointmax) 0) (point-max))
476 (semantic-clear-toplevel-cache)
478 (semantic-set-unmatched-syntax-cache
479 (oref ctbl unmatched-syntax))
481 ;; Old version of the semanticdb table can miss the unmatched
482 ;; syntax slot. If so, just clear the unmatched syntax cache.
483 (semantic-clear-unmatched-syntax-cache)
484 ;; Make sure it has a value.
485 (oset ctbl unmatched-syntax nil)
487 (semantic--set-buffer-cache (oref ctbl tags))
488 (semantic--tag-link-cache-to-buffer)
492 (defun semanticdb-synchronize-table (new-table)
493 "Function run after parsing.
494 Argument NEW-TABLE is the new table of tags."
495 (if semanticdb-current-table
496 (oset semanticdb-current-table tags new-table)))
498 (defun semanticdb-kill-hook ()
499 "Function run when a buffer is killed.
500 If there is a semantic cache, slurp out the overlays, and store
501 it in our database. If that buffer has no cache, ignore it, we'll
502 handle it later if need be."
503 (if (and (semantic-active-p)
504 semantic--buffer-cache
505 semanticdb-current-table)
507 (oset semanticdb-current-table pointmax (point-max))
509 (semantic--tag-unlink-cache-from-buffer)
510 ;; If this messes up, just clear the system
512 (semantic-clear-toplevel-cache)
513 (message "semanticdb: Failed to deoverlay tag cache."))))
516 (defun semanticdb-kill-emacs-hook ()
517 "Function called when Emacs is killed.
518 Save all the databases."
519 (semanticdb-save-all-db))
521 ;;; Start/Stop database use
523 (defvar semanticdb-hooks
524 '((semanticdb-semantic-init-hook-fcn semantic-init-db-hooks)
525 (semanticdb-synchronize-table semantic-after-toplevel-cache-change-hook)
526 (semanticdb-kill-hook kill-buffer-hook)
527 (semanticdb-kill-emacs-hook kill-emacs-hook)
529 "List of hooks and values to add/remove when configuring semanticdb.")
532 (defun semanticdb-minor-mode-p ()
533 "Return non-nil if `semanticdb-minor-mode' is active."
534 (member (car (car semanticdb-hooks))
535 (symbol-value (car (cdr (car semanticdb-hooks))))))
538 (defun global-semanticdb-minor-mode (&optional arg)
539 "Toggle the use of `semanticdb-minor-mode'.
540 If ARG is positive, enable, if it is negative, disable.
541 If ARG is nil, then toggle."
544 (if (semanticdb-minor-mode-p)
548 (h semanticdb-hooks))
550 (setq semanticdb-global-mode nil
552 (setq semanticdb-global-mode t))
553 ;(message "ARG = %d" arg)
555 (funcall fn (car (cdr (car h))) (car (car h)))
558 (run-hooks 'semanticdb-mode-hooks)
561 (defun semanticdb-toggle-global-mode ()
562 "Toggle use of the Semantic Database feature.
563 Update the environment of Semantic enabled buffers accordingly."
565 (if (semanticdb-minor-mode-p)
566 ;; Save databases before disabling semanticdb.
567 (semanticdb-save-all-db))
568 ;; Toggle semanticdb minor mode.
569 (global-semanticdb-minor-mode))
572 ;;; Validate the semantic database
574 (defun semanticdb-table-oob-sanity-check (cache)
575 "Validate that CACHE tags do not have any overlays in them."
577 (when (semantic-overlay-p (semantic-tag-overlay cache))
578 (message "Tag %s has an erroneous overlay!"
579 (semantic-format-tag-summarize (car cache))))
580 (semanticdb-table-oob-sanity-check
581 (semantic-tag-components-with-overlays (car cache)))
582 (setq cache (cdr cache))))
584 (defun semanticdb-table-sanity-check (&optional table)
585 "Validate the current semanticdb TABLE."
587 (if (not table) (setq table semanticdb-current-table))
588 (let* ((full-filename (semanticdb-full-filename table))
589 (buff (get-file-buffer full-filename)))
593 (semantic-sanity-check))
594 ;; We can't use the usual semantic validity check, so hack our own.
595 (semanticdb-table-oob-sanity-check (semanticdb-get-tags table)))))
597 (defun semanticdb-database-sanity-check ()
598 "Validate the current semantic database."
600 (let ((tables (semanticdb-get-database-tables
601 semanticdb-current-database)))
603 (semanticdb-table-sanity-check (car tables))
604 (setq tables (cdr tables)))
607 (defun semanticdb-dump-all-table-summary ()
608 "Dump a list of all databases in Emacs memory."
610 (require 'semantic-adebug)
611 (let ((ab (semantic-adebug-new-buffer "*SEMANTICDB*"))
612 (db semanticdb-database-list))
613 (semantic-adebug-insert-stuff-list db "*")))
616 ;; (with-output-to-temp-buffer "*SEMANTICDB*"
618 ;; (princ (object-name (car db)))
620 ;; (if (slot-boundp (car db) 'reference-directory)
621 ;; (princ (oref (car db) reference-directory))
622 ;; (princ "System DB"))
624 ;; (setq db (cdr db))))
627 ;;; Generic Accessor Routines
629 ;; These routines can be used to get at tags in files w/out
630 ;; having to know a lot about semanticDB.
633 (defun semanticdb-file-table-object (file &optional dontload)
634 "Return a semanticdb table belonging to FILE.
635 If file has database tags available in the database, return it.
636 If file does not have tags available, and DONTLOAD is nil,
637 then load the tags for FILE, and create a new table object for it.
638 DONTLOAD does not affect the creation of new database objects."
639 (setq file (expand-file-name file))
640 (when (file-exists-p file)
641 (let* ((default-directory (file-name-directory file))
643 ;; This line will pick up system databases.
644 (semanticdb-directory-loaded-p default-directory)
645 ;; this line will make a new one if needed.
646 (semanticdb-get-database default-directory)))
648 (or (semanticdb-file-table db file)
649 ;; We must load the file.
652 (set-buffer (find-file-noselect file t))
653 ;; Find file should automatically do this for us.
654 ;; Sometimes the DB table doesn't contains tags and needs
655 ;; a refresh. For example, when the file is loaded for
656 ;; the first time, and the idle scheduler didn't get a
657 ;; chance to trigger a parse before the file buffer is
659 (when (semanticdb-needs-refresh-p semanticdb-current-table)
660 (semanticdb-refresh-table semanticdb-current-table))
662 semanticdb-current-table
663 ;; If we had to find the file, then we should kill it
664 ;; to keep the master buffer list clean.
665 (kill-buffer (current-buffer))))))
669 (defun semanticdb-file-stream (file)
670 "Return a list of tags belonging to FILE.
671 If file has database tags available in the database, return them.
672 If file does not have tags available, then load the file, and create them."
673 (let ((table (semanticdb-file-table-object file)))
675 (semanticdb-get-tags table))))
677 (provide 'semanticdb)
679 ;;; semanticdb.el ends here