1 ;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
3 ;;; Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5 ;; Authors: Eric M. Ludlam <zappo@gnu.org>, Joakim Verona
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; This program was started by Eric Ludlam, and Joakim Verona finished
26 ;; the implementation by adding searches and fixing bugs.
28 ;; Read in custom-created ebrowse BROWSE files into a semanticdb back
31 ;; Add these databases to the 'system' search.
32 ;; Possibly use ebrowse for local parsing too.
34 ;; When real details are needed out of the tag system from ebrowse,
35 ;; we will need to delve into the originating source and parse those
36 ;; files the usual way.
39 ;; `semanticdb-create-ebrowse-database' - Call EBROWSE to create a
40 ;; system database for some directory. In general, use this for
41 ;; system libraries, such as /usr/include, or include directories
42 ;; large software projects.
43 ;; Customize `semanticdb-ebrowse-file-match' to make sure the correct
44 ;; file extensions are matched.
46 ;; `semanticdb-load-ebrowse-caches' - Load all the EBROWSE caches from
47 ;; your semanticdb system database directory. Once they are
48 ;; loaded, they become searchable as omnipotent databases for
49 ;; all C++ files. This is called automatically by semantic-load.
50 ;; Call it a second time to refresh the Emacs DB with the file.
54 ;; For generic function searching.
58 (require 'semantic/db-file)
59 (require 'semantic/find)
61 (declare-function semantic-add-system-include "semantic/dep")
62 (declare-function data-debug-new-buffer "data-debug")
63 (declare-function data-debug-insert-thing "data-debug")
66 ;; Hopefully, this will allow semanticdb-ebrowse to compile under
67 ;; XEmacs, it just won't run if a user attempts to use it.
73 (defvar semanticdb-ebrowse-default-file-name "BROWSE"
74 "The EBROWSE file name used for system caches.")
76 (defcustom semanticdb-ebrowse-file-match "\\.\\(hh?\\|HH?\\|hpp\\)"
77 "Regular expression matching file names for ebrowse to parse.
78 This expression should exclude C++ headers that have no extension.
79 By default, include only headers since the semantic use of EBrowse
80 is only for searching via semanticdb, and thus only headers would
85 ;;; SEMANTIC Database related Code
87 (defclass semanticdb-table-ebrowse (semanticdb-table)
88 ((major-mode :initform c++-mode)
89 (ebrowse-tree :initform nil
90 :initarg :ebrowse-tree
92 "The raw ebrowse tree for this file."
94 (global-extract :initform nil
95 :initarg :global-extract
97 "Table of ebrowse tags specific to this file.
98 This table is compisited from the ebrowse *Globals* section.")
100 "A table for returning search results from ebrowse.")
102 (defclass semanticdb-project-database-ebrowse
103 (semanticdb-project-database)
104 ((new-table-class :initform semanticdb-table-ebrowse
107 "New tables created for this database are of this class.")
108 (system-include-p :initform nil
109 :initarg :system-include
111 "Flag indicating this database represents a system include directory.")
112 (ebrowse-struct :initform nil
113 :initarg :ebrowse-struct
116 "Semantic Database deriving tags using the EBROWSE tool.
117 EBROWSE is a C/C++ parser for use with `ebrowse' Emacs program.")
120 (defun semanticdb-ebrowse-C-file-p (file)
121 "Is FILE a C or C++ file?"
122 (or (string-match semanticdb-ebrowse-file-match file)
123 (and (string-match "/\\w+$" file)
124 (not (file-directory-p file))
125 (let ((tmp (get-buffer-create "*semanticdb-ebrowse-tmp*")))
129 (insert-file-contents file nil 0 100 t)
130 (error (insert-file-contents file nil nil nil t)))
131 (goto-char (point-min))
132 (looking-at "\\s-*/\\(\\*\\|/\\)")
136 (defun semanticdb-create-ebrowse-database (dir)
137 "Create an EBROSE database for directory DIR.
138 The database file is stored in ~/.semanticdb, or whichever directory
139 is specified by `semanticdb-default-save-directory'."
140 (interactive "DDirectory: ")
141 (setq dir (file-name-as-directory dir)) ;; for / on end
142 (let* ((savein (semanticdb-ebrowse-file-for-directory dir))
143 (filebuff (get-buffer-create "*SEMANTICDB EBROWSE TMP*"))
144 (files (directory-files (expand-file-name dir) t))
145 (mma auto-mode-alist)
148 ;; Create the input to the ebrowse command
150 (set-buffer filebuff)
151 (buffer-disable-undo filebuff)
152 (setq default-directory (expand-file-name dir))
154 ;;; @TODO - convert to use semanticdb-collect-matching-filenames
155 ;; to get the file names.
159 (when (semanticdb-ebrowse-C-file-p f)
163 ;; Cleanup the ebrowse output buffer.
165 (set-buffer (get-buffer-create "*EBROWSE OUTPUT*"))
167 ;; Call the EBROWSE command.
168 (message "Creating ebrowse file: %s ..." savein)
169 (call-process-region (point-min) (point-max)
170 "ebrowse" nil "*EBROWSE OUTPUT*" nil
171 (concat "--output-file=" savein)
174 ;; Create a short LOADER program for loading in this database.
175 (let* ((lfn (concat savein "-load.el"))
176 (lf (find-file-noselect lfn)))
180 (insert "(semanticdb-ebrowse-load-helper \""
181 (expand-file-name dir)
184 (kill-buffer (current-buffer)))
185 (message "Creating ebrowse file: %s ... done" savein)
186 ;; Reload that database
190 (defun semanticdb-load-ebrowse-caches ()
191 "Load all semanticdb controlled EBROWSE caches."
193 (let ((f (directory-files semanticdb-default-save-directory
194 t (concat semanticdb-ebrowse-default-file-name "-load.el$") t)))
200 (defun semanticdb-ebrowse-load-helper (directory)
201 "Create the semanticdb database via ebrowse for directory.
202 If DIRECTORY is found to be defunct, it won't load the DB, and will
204 (if (file-directory-p directory)
205 (semanticdb-create-database semanticdb-project-database-ebrowse
207 (let* ((BF (semanticdb-ebrowse-file-for-directory directory))
208 (BFL (concat BF "-load.el"))
209 (BFLB (concat BF "-load.el~")))
210 (save-window-excursion
211 (with-output-to-temp-buffer "*FILES TO DELETE*"
212 (princ "The following BROWSE files are obsolete.\n\n")
217 (when (file-exists-p BFLB)
221 (when (y-or-n-p (format
222 "Warning: Obsolete BROWSE file for: %s\nDelete? "
226 (when (file-exists-p BFLB)
230 ;JAVE this just instantiates a default empty ebrowse struct?
231 ; how would new instances wind up here?
232 ; the ebrowse class isnt singleton, unlike the emacs lisp one
233 (defvar-mode-local c++-mode semanticdb-project-system-databases
235 "Search Ebrowse for symbols.")
237 (defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
238 "EBROWSE database do not need to be refreshed.
240 JAVE: stub for needs-refresh, because, how do we know if BROWSE files
243 EML: Our database should probably remember the timestamp/checksum of
244 the most recently read EBROWSE file, and use that."
249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
255 ;; These routines deal with part of the ebrowse interface.
256 (defun semanticdb-ebrowse-file-for-directory (dir)
257 "Return the file name for DIR where the ebrowse BROWSE file is.
258 This file should reside in `semanticdb-default-save-directory'."
259 (let* ((semanticdb-default-save-directory
260 semanticdb-default-save-directory)
261 (B (semanticdb-file-name-directory
262 'semanticdb-project-database-file
263 (concat (expand-file-name dir)
264 semanticdb-ebrowse-default-file-name)))
268 (defun semanticdb-ebrowse-get-ebrowse-structure (dir)
269 "Return the ebrowse structure for directory DIR.
270 This assumes semantic manages the BROWSE files, so they are assumed to live
271 where semantic cache files live, depending on your settings.
273 For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
274 (let* ((B (semanticdb-ebrowse-file-for-directory dir))
275 (buf (get-buffer-create "*semanticdb ebrowse*")))
276 (message "semanticdb-ebrowse %s" B)
277 (when (file-exists-p B)
279 (buffer-disable-undo buf)
281 (insert-file-contents B)
283 (efcn (symbol-function 'ebrowse-show-progress)))
284 (fset 'ebrowse-show-progress #'(lambda (&rest junk) nil))
285 (unwind-protect ;; Protect against errors w/ ebrowse
286 (setq ans (list B (ebrowse-read)))
287 ;; These items must always happen
289 (fset 'ebrowse-show-fcn efcn)
293 ;;; Methods for creating a database or tables
295 (defmethod semanticdb-create-database :STATIC ((dbeC semanticdb-project-database-ebrowse)
297 "Create a new semantic database for DIRECTORY based on ebrowse.
298 If there is no database for DIRECTORY available, then
299 {not implemented yet} create one. Return nil if that is not possible."
300 ;; MAKE SURE THAT THE FILE LOADED DOESN'T ALREADY EXIST.
301 (require 'semantic/dep)
302 (let ((dbs semanticdb-database-list)
304 (while (and (not found) dbs)
305 (when (semanticdb-project-database-ebrowse-p (car dbs))
306 (when (string= (oref (car dbs) reference-directory) directory)
307 (setq found (car dbs))))
308 (setq dbs (cdr dbs)))
309 ;;STATIC means DBE cant be used as object, only as a class
310 (let* ((ebrowse-data (semanticdb-ebrowse-get-ebrowse-structure directory))
311 (dat (car (cdr ebrowse-data)))
314 (default-directory directory)
318 (setq db (make-instance
323 (oset db reference-directory directory))
325 ;; Once we recycle or make a new DB, refresh the
326 ;; contents from the BROWSE file.
328 ;; only possible after object creation, tables inited to nil.
329 (semanticdb-ebrowse-strip-trees db dat)
331 ;; Once our database is loaded, if we are a system DB, we
332 ;; add ourselves to the include list for C++.
333 (semantic-add-system-include directory 'c++-mode)
334 (semantic-add-system-include directory 'c-mode)
338 (defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
340 "For the ebrowse database DBE, strip all tables from DATA."
341 ;JAVE what it actually seems to do is split the original tree in "tables" associated with files
342 ; im not sure it actually works:
343 ; the filename slot sometimes gets to be nil,
344 ; apparently for classes which definition cant be found, yet needs to be included in the tree
345 ; like library baseclasses
346 ; a file can define several classes
347 (let ((T (car (cdr data))));1st comes a header, then the tree
350 (let* ((tree (car T))
351 (class (ebrowse-ts-class tree)); root class of tree
352 ;; Something funny going on with this file thing...
353 (filename (or (ebrowse-cs-source-file class)
354 (ebrowse-cs-file class)))
357 ((ebrowse-globals-tree-p tree)
358 ;; We have the globals tree.. save this special.
359 (semanticdb-ebrowse-add-globals-to-table dbe tree)
362 ;; ebrowse will collect all the info from multiple files
363 ;; into one tree. Semantic wants all the bits to be tied
364 ;; into different files. We need to do a full dissociation
365 ;; into semantic parsable tables.
366 (semanticdb-ebrowse-add-tree-to-table dbe tree)
371 ;;; Filename based methods
373 (defun semanticdb-ebrowse-add-globals-to-table (dbe tree)
374 "For database DBE, add the ebrowse TREE into the table."
375 (if (or (not (ebrowse-ts-p tree))
376 (not (ebrowse-globals-tree-p tree)))
377 (signal 'wrong-type-argument (list 'ebrowse-ts-p tree)))
379 (let* ((class (ebrowse-ts-class tree))
380 (fname (or (ebrowse-cs-source-file class)
381 (ebrowse-cs-file class)
382 ;; Not def'd here, assume our current
384 (concat default-directory "/unknown-proxy.hh")))
385 (vars (ebrowse-ts-member-functions tree))
386 (fns (ebrowse-ts-member-variables tree))
390 (let ((nt (semantic-tag (ebrowse-ms-name (car vars))
392 (defpoint (ebrowse-bs-point class)))
394 (semantic--tag-set-overlay nt
395 (vector defpoint defpoint)))
396 (setq toks (cons nt toks)))
397 (setq vars (cdr vars)))
399 (let ((nt (semantic-tag (ebrowse-ms-name (car fns))
401 (defpoint (ebrowse-bs-point class)))
403 (semantic--tag-set-overlay nt
404 (vector defpoint defpoint)))
405 (setq toks (cons nt toks)))
406 (setq fns (cdr fns)))
410 (defun semanticdb-ebrowse-add-tree-to-table (dbe tree &optional fname baseclasses)
411 "For database DBE, add the ebrowse TREE into the table for FNAME.
412 Optional argument BASECLASSES specifyies a baseclass to the tree being provided."
413 (if (not (ebrowse-ts-p tree))
414 (signal 'wrong-type-argument (list 'ebrowse-ts-p tree)))
416 ;; Strategy overview:
417 ;; 1) Calculate the filename for this tree.
418 ;; 2) Find a matching namespace in TAB, or create a new one.
419 ;; 3) Fabricate a tag proxy for CLASS
420 ;; 4) Add it to the namespace
423 ;; 1 - Find the filename
425 (setq fname (or (ebrowse-cs-source-file (ebrowse-ts-class tree))
426 (ebrowse-cs-file (ebrowse-ts-class tree))
427 ;; Not def'd here, assume our current
429 (concat default-directory "/unknown-proxy.hh"))))
431 (let* ((tab (or (semanticdb-file-table dbe fname)
432 (semanticdb-create-table dbe fname)))
433 (class (ebrowse-ts-class tree))
434 (scope (ebrowse-cs-scope class))
435 (ns (when scope (split-string scope ":" t)))
440 ;; 2 - Get the namespace tag
442 (let ((taglst (if (slot-boundp tab 'tags) (oref tab tags) nil)))
443 (setq nst (semantic-find-first-tag-by-name (car ns) taglst))
445 (setq nst (semantic-tag (car ns) 'type :type "namespace"))
446 (oset tab tags (cons nst taglst))
449 ;; 3 - Create a proxy tg.
450 (setq cls (semantic-tag (ebrowse-cs-name class)
453 :superclasses baseclasses
457 (let ((defpoint (ebrowse-bs-point class)))
459 (semantic--tag-set-overlay cls
460 (vector defpoint defpoint))))
462 ;; 4 - add to namespace
464 (semantic-tag-put-attribute
465 nst :members (cons cls (semantic-tag-get-attribute nst :members)))
466 (oset tab tags (cons cls (when (slot-boundp tab 'tags)
470 (let* ((subclass (ebrowse-ts-subclasses tree))
471 (pname (ebrowse-cs-name class)))
472 (when (ebrowse-cs-scope class)
473 (setq pname (concat (mapconcat (lambda (a) a) (cdr ns) "::") "::" pname)))
476 (let* ((scc (ebrowse-ts-class (car subclass)))
477 (fname (or (ebrowse-cs-source-file scc)
478 (ebrowse-cs-file scc)
479 ;; Not def'd here, assume our current
484 (semanticdb-ebrowse-add-tree-to-table
485 dbe (car subclass) fname pname)))
486 (setq subclass (cdr subclass))))
490 ;; Overload for converting the simple faux tag into something better.
492 (defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
493 "Convert in Ebrowse database OBJ a list of TAGS into a complete tag.
494 The default tag provided by searches exclude many features of a
495 semantic parsed tag. Look up the file for OBJ, and match TAGS
496 against a semantic parsed tag that has all the info needed, and
500 ;; SemanticDB will automatically create a regular database
501 ;; on top of the file just loaded by ebrowse during the set
502 ;; buffer. Fetch that table, and use it's tag list to look
503 ;; up the tag we just got, and thus turn it into a full semantic
506 (let ((tag (car tags)))
508 (semanticdb-set-buffer obj)
510 ;; Gee, it would be nice to do this, but ebrowse LIES. Oi.
511 (when (semantic-tag-with-position-p tag)
512 (goto-char (semantic-tag-start tag))
513 (let ((foundtag (semantic-current-tag)))
514 ;; Make sure the discovered tag is the same as what we started with.
515 (when (string= (semantic-tag-name tag)
516 (semantic-tag-name foundtag))
518 (setq ans foundtag))))
519 ;; Sometimes ebrowse lies. Do a generic search
520 ;; to find it within this file.
522 ;; We might find multiple hits for this tag, and we have no way
523 ;; of knowing which one the user wanted. Return the first one.
524 (setq ans (semantic-deep-find-tags-by-name
525 (semantic-tag-name tag)
526 (semantic-fetch-tags))))
527 (if (semantic-tag-p ans)
528 (setq tagret (cons ans tagret))
529 (setq tagret (append ans tagret)))
531 (setq tags (cdr tags))))
534 (defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
535 "Convert in Ebrowse database OBJ one TAG into a complete tag.
536 The default tag provided by searches exclude many features of a
537 semantic parsed tag. Look up the file for OBJ, and match TAG
538 against a semantic parsed tag that has all the info needed, and
542 ;; SemanticDB will automatically create a regular database
543 ;; on top of the file just loaded by ebrowse during the set
544 ;; buffer. Fetch that table, and use it's tag list to look
545 ;; up the tag we just got, and thus turn it into a full semantic
548 (semanticdb-set-buffer obj)
549 (setq objret semanticdb-current-table)
554 ;; Gee, it would be nice to do this, but ebrowse LIES. Oi.
555 (when (semantic-tag-with-position-p tag)
556 (goto-char (semantic-tag-start tag))
557 (let ((foundtag (semantic-current-tag)))
558 ;; Make sure the discovered tag is the same as what we started with.
559 (when (string= (semantic-tag-name tag)
560 (semantic-tag-name foundtag))
562 (setq ans foundtag))))
563 ;; Sometimes ebrowse lies. Do a generic search
564 ;; to find it within this file.
566 ;; We might find multiple hits for this tag, and we have no way
567 ;; of knowing which one the user wanted. Return the first one.
568 (setq ans (semantic-deep-find-tags-by-name
569 (semantic-tag-name tag)
570 (semantic-fetch-tags))))
571 (if (semantic-tag-p ans)
573 (setq tagret (car ans)))
575 (cons objret tagret)))
579 ;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
580 ;; how your new search routines are implemented.
582 (defmethod semanticdb-find-tags-by-name-method
583 ((table semanticdb-table-ebrowse) name &optional tags)
584 "Find all tags named NAME in TABLE.
585 Return a list of tags."
586 ;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
588 ;; If TAGS are passed in, then we don't need to do work here.
590 ;; If we ever need to do something special, add here.
591 ;; Since ebrowse tags are converted into semantic tags, we can
592 ;; get away with this sort of thing.
597 (defmethod semanticdb-find-tags-by-name-regexp-method
598 ((table semanticdb-table-ebrowse) regex &optional tags)
599 "Find all tags with name matching REGEX in TABLE.
600 Optional argument TAGS is a list of tags to search.
601 Return a list of tags."
602 (if tags (call-next-method)
603 ;; YOUR IMPLEMENTATION HERE
607 (defmethod semanticdb-find-tags-for-completion-method
608 ((table semanticdb-table-ebrowse) prefix &optional tags)
609 "In TABLE, find all occurances of tags matching PREFIX.
610 Optional argument TAGS is a list of tags to search.
611 Returns a table of all matching tags."
612 (if tags (call-next-method)
613 ;; YOUR IMPLEMENTATION HERE
617 (defmethod semanticdb-find-tags-by-class-method
618 ((table semanticdb-table-ebrowse) class &optional tags)
619 "In TABLE, find all occurances of tags of CLASS.
620 Optional argument TAGS is a list of tags to search.
621 Returns a table of all matching tags."
622 (if tags (call-next-method)
625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
629 ;; If your language does not have a `deep' concept, these can be left
630 ;; alone, otherwise replace with implementations similar to those
634 (defmethod semanticdb-deep-find-tags-by-name-method
635 ((table semanticdb-table-ebrowse) name &optional tags)
636 "Find all tags name NAME in TABLE.
637 Optional argument TAGS is a list of tags t
638 Like `semanticdb-find-tags-by-name-method' for ebrowse."
639 ;;(semanticdb-find-tags-by-name-method table name tags)
642 (defmethod semanticdb-deep-find-tags-by-name-regexp-method
643 ((table semanticdb-table-ebrowse) regex &optional tags)
644 "Find all tags with name matching REGEX in TABLE.
645 Optional argument TAGS is a list of tags to search.
646 Like `semanticdb-find-tags-by-name-method' for ebrowse."
647 ;;(semanticdb-find-tags-by-name-regexp-method table regex tags)
650 (defmethod semanticdb-deep-find-tags-for-completion-method
651 ((table semanticdb-table-ebrowse) prefix &optional tags)
652 "In TABLE, find all occurances of tags matching PREFIX.
653 Optional argument TAGS is a list of tags to search.
654 Like `semanticdb-find-tags-for-completion-method' for ebrowse."
655 ;;(semanticdb-find-tags-for-completion-method table prefix tags)
658 ;;; Advanced Searches
660 (defmethod semanticdb-find-tags-external-children-of-type-method
661 ((table semanticdb-table-ebrowse) type &optional tags)
662 "Find all nonterminals which are child elements of TYPE
663 Optional argument TAGS is a list of tags to search.
664 Return a list of tags."
665 (if tags (call-next-method)
666 ;; Ebrowse collects all this type of stuff together for us.
667 ;; but we can't use it.... yet.
673 ;; This is a complex bit of stuff. Here are some tests for the
676 (defun semanticdb-ebrowse-run-tests ()
677 "Run some tests of the semanticdb-ebrowse system.
678 All systems are different. Ask questions along the way."
681 (when (y-or-n-p "Create a system database to test with? ")
682 (call-interactively 'semanticdb-create-ebrowse-database)
684 ;; Should we load in caches
686 (y-or-n-p "New database created. Reload system databases? ")
687 (y-or-n-p "Load in all system databases? "))
688 (semanticdb-load-ebrowse-caches)))
689 ;; Ok, databases were creatd. Lets try some searching.
690 (when (not (or (eq major-mode 'c-mode)
691 (eq major-mode 'c++-mode)))
692 (error "Please make your default buffer be a C or C++ file, then
693 run the test again..")
698 (defun semanticdb-ebrowse-dump ()
699 "Find the first loaded ebrowse table, and dump out the contents."
701 (require 'data-debug)
702 (let ((db semanticdb-database-list)
705 (when (semanticdb-project-database-ebrowse-p (car db))
706 (setq ab (data-debug-new-buffer "*EBROWSE Database*"))
707 (data-debug-insert-thing (car db) "*" "")
710 (setq db (cdr db)))))
712 (provide 'semantic/db-ebrowse)
714 ;;; semantic/db-ebrowse.el ends here