Mercurial > emacs
comparison lisp/cedet/semantic/db-mode.el @ 104436:b9b48267c7d3
cedet/semantic/db-mode.el: New file.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 30 Aug 2009 14:37:55 +0000 |
parents | |
children | 902d22a2d922 |
comparison
equal
deleted
inserted
replaced
104435:52067a6bf088 | 104436:b9b48267c7d3 |
---|---|
1 ;;; semantic/db-mode.el --- Semanticdb Minor Mode | |
2 | |
3 ;; Copyright (C) 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 ;; Major mode for managing Semantic Databases automatically. | |
25 | |
26 (require 'semantic/db) | |
27 ;;; Code: | |
28 (defvar semanticdb-current-database nil | |
29 "For a given buffer, this is the currently active database.") | |
30 (make-variable-buffer-local 'semanticdb-current-database) | |
31 | |
32 (defvar semanticdb-current-table nil | |
33 "For a given buffer, this is the currently active database table.") | |
34 (make-variable-buffer-local 'semanticdb-current-table) | |
35 | |
36 (defcustom semanticdb-global-mode nil | |
37 "*If non-nil enable the use of `semanticdb-minor-mode'." | |
38 :group 'semantic | |
39 :type 'boolean | |
40 :require 'semantic/db | |
41 :initialize 'custom-initialize-default | |
42 :set (lambda (sym val) | |
43 (global-semanticdb-minor-mode (if val 1 -1)) | |
44 (custom-set-default sym val))) | |
45 | |
46 (defcustom semanticdb-mode-hooks nil | |
47 "*Hooks run whenever `global-semanticdb-minor-mode' is run. | |
48 Use `semanticdb-minor-mode-p' to determine if the mode has been turned | |
49 on or off." | |
50 :group 'semanticdb | |
51 :type 'hook) | |
52 | |
53 ;;; Start/Stop database use | |
54 ;; | |
55 (defvar semanticdb-hooks | |
56 '((semanticdb-semantic-init-hook-fcn semantic-init-db-hooks) | |
57 (semanticdb-synchronize-table semantic-after-toplevel-cache-change-hook) | |
58 (semanticdb-partial-synchronize-table semantic-after-partial-cache-change-hook) | |
59 (semanticdb-revert-hook before-revert-hook) | |
60 (semanticdb-kill-hook kill-buffer-hook) | |
61 (semanticdb-kill-hook change-major-mode-hook) ;; Not really a kill, but we need the same effect. | |
62 (semanticdb-kill-emacs-hook kill-emacs-hook) | |
63 (semanticdb-save-all-db-idle auto-save-hook) | |
64 ) | |
65 "List of hooks and values to add/remove when configuring semanticdb.") | |
66 | |
67 ;;; SEMANTICDB-MODE | |
68 ;; | |
69 (defun semanticdb-minor-mode-p () | |
70 "Return non-nil if `semanticdb-minor-mode' is active." | |
71 (member (car (car semanticdb-hooks)) | |
72 (symbol-value (car (cdr (car semanticdb-hooks)))))) | |
73 | |
74 (defun global-semanticdb-minor-mode (&optional arg) | |
75 "Toggle the use of `semanticdb-minor-mode'. | |
76 If ARG is positive, enable, if it is negative, disable. | |
77 If ARG is nil, then toggle." | |
78 (interactive "P") | |
79 (if (not arg) | |
80 (if (semanticdb-minor-mode-p) | |
81 (setq arg -1) | |
82 (setq arg 1))) | |
83 (let ((fn 'add-hook) | |
84 (h semanticdb-hooks) | |
85 (changed nil)) | |
86 (if (< arg 0) | |
87 (setq changed semanticdb-global-mode | |
88 semanticdb-global-mode nil | |
89 fn 'remove-hook) | |
90 (setq changed (not semanticdb-global-mode) | |
91 semanticdb-global-mode t)) | |
92 ;(message "ARG = %d" arg) | |
93 (when changed | |
94 (while h | |
95 (funcall fn (car (cdr (car h))) (car (car h))) | |
96 (setq h (cdr h))) | |
97 ;; Call a hook | |
98 (run-hooks 'semanticdb-mode-hooks)) | |
99 )) | |
100 | |
101 (defun semanticdb-toggle-global-mode () | |
102 "Toggle use of the Semantic Database feature. | |
103 Update the environment of Semantic enabled buffers accordingly." | |
104 (interactive) | |
105 (if (semanticdb-minor-mode-p) | |
106 ;; Save databases before disabling semanticdb. | |
107 (semanticdb-save-all-db)) | |
108 ;; Toggle semanticdb minor mode. | |
109 (global-semanticdb-minor-mode)) | |
110 | |
111 ;;; Hook Functions: | |
112 ;; | |
113 ;; Functions used in hooks to keep SemanticDB operating. | |
114 ;; | |
115 (defun semanticdb-semantic-init-hook-fcn () | |
116 "Function saved in `semantic-init-db-hooks'. | |
117 Sets up the semanticdb environment." | |
118 ;; Only initialize semanticdb if we have a file name. | |
119 ;; There is no reason to cache a tag table if there is no | |
120 ;; way to load it back in later. | |
121 (when (buffer-file-name) | |
122 (let* ((ans (semanticdb-create-table-for-file (buffer-file-name))) | |
123 (cdb (car ans)) | |
124 (ctbl (cdr ans)) | |
125 ) | |
126 ;; Get the current DB for this directory | |
127 (setq semanticdb-current-database cdb) | |
128 ;; We set the major mode because we know what it is. | |
129 (oset ctbl major-mode major-mode) | |
130 ;; Local state | |
131 (setq semanticdb-current-table ctbl) | |
132 ;; Try to swap in saved tags | |
133 (if (or (not (slot-boundp ctbl 'tags)) (not (oref ctbl tags)) | |
134 (/= (or (oref ctbl pointmax) 0) (point-max)) | |
135 ) | |
136 (semantic-clear-toplevel-cache) | |
137 ;; Unmatched syntax | |
138 (condition-case nil | |
139 (semantic-set-unmatched-syntax-cache | |
140 (oref ctbl unmatched-syntax)) | |
141 (unbound-slot | |
142 ;; Old version of the semanticdb table can miss the unmatched | |
143 ;; syntax slot. If so, just clear the unmatched syntax cache. | |
144 (semantic-clear-unmatched-syntax-cache) | |
145 ;; Make sure it has a value. | |
146 (oset ctbl unmatched-syntax nil) | |
147 )) | |
148 ;; Keep lexical tables up to date. Don't load | |
149 ;; semantic-spp if it isn't needed. | |
150 (let ((lt (oref ctbl lexical-table))) | |
151 (when lt | |
152 (require 'semantic/lex-spp) | |
153 (semantic-lex-spp-set-dynamic-table lt))) | |
154 ;; Set the main tag cache. | |
155 ;; This must happen after setting up buffer local variables | |
156 ;; since this will turn around and re-save those variables. | |
157 (semantic--set-buffer-cache (oref ctbl tags)) | |
158 ;; Don't need it to be dirty. Set dirty due to hooks from above. | |
159 (oset ctbl dirty nil) ;; Special case here. | |
160 (oset ctbl buffer (current-buffer)) | |
161 ;; Bind into the buffer. | |
162 (semantic--tag-link-cache-to-buffer) | |
163 ) | |
164 ))) | |
165 | |
166 (defun semanticdb-revert-hook () | |
167 "Hook run before a revert buffer. | |
168 We can't track incremental changes due to a revert, so just clear the cache. | |
169 This will prevent the next batch of hooks from wasting time parsing things | |
170 that don't need to be parsed." | |
171 (if (and (semantic-active-p) | |
172 semantic--buffer-cache | |
173 semanticdb-current-table) | |
174 (semantic-clear-toplevel-cache))) | |
175 | |
176 (defun semanticdb-kill-hook () | |
177 "Function run when a buffer is killed. | |
178 If there is a semantic cache, slurp out the overlays, and store | |
179 it in our database. If that buffer has no cache, ignore it, we'll | |
180 handle it later if need be." | |
181 (when (and (semantic-active-p) | |
182 semantic--buffer-cache | |
183 semanticdb-current-table) | |
184 | |
185 ;; Try to get a fast update. | |
186 (semantic-fetch-tags-fast) | |
187 | |
188 ;; If the buffer is in a bad state, don't save anything... | |
189 (if (semantic-parse-tree-needs-rebuild-p) | |
190 ;; If this is the case, don't save anything. | |
191 (progn | |
192 (semantic-clear-toplevel-cache) | |
193 (oset semanticdb-current-table pointmax 0) | |
194 (oset semanticdb-current-table fsize 0) | |
195 (oset semanticdb-current-table lastmodtime nil) | |
196 ) | |
197 ;; We have a clean buffer, save it off. | |
198 (condition-case nil | |
199 (progn | |
200 (semantic--tag-unlink-cache-from-buffer) | |
201 ;; Set pointmax only if we had some success in the unlink. | |
202 (oset semanticdb-current-table pointmax (point-max)) | |
203 (let ((fattr (file-attributes | |
204 (semanticdb-full-filename | |
205 semanticdb-current-table)))) | |
206 (oset semanticdb-current-table fsize (nth 7 fattr)) | |
207 (oset semanticdb-current-table lastmodtime (nth 5 fattr)) | |
208 (oset semanticdb-current-table buffer nil) | |
209 )) | |
210 ;; If this messes up, just clear the system | |
211 (error | |
212 (semantic-clear-toplevel-cache) | |
213 (message "semanticdb: Failed to deoverlay tag cache."))) | |
214 ) | |
215 )) | |
216 | |
217 (defun semanticdb-kill-emacs-hook () | |
218 "Function called when Emacs is killed. | |
219 Save all the databases." | |
220 (semanticdb-save-all-db)) | |
221 | |
222 ;;; SYNCHRONIZATION HOOKS | |
223 ;; | |
224 (defun semanticdb-synchronize-table (new-table) | |
225 "Function run after parsing. | |
226 Argument NEW-TABLE is the new table of tags." | |
227 (when semanticdb-current-table | |
228 (semanticdb-synchronize semanticdb-current-table new-table))) | |
229 | |
230 (defun semanticdb-partial-synchronize-table (new-table) | |
231 "Function run after parsing. | |
232 Argument NEW-TABLE is the new table of tags." | |
233 (when semanticdb-current-table | |
234 (semanticdb-partial-synchronize semanticdb-current-table new-table))) | |
235 | |
236 | |
237 (provide 'semantic/db-mode) | |
238 | |
239 ;;; semantic/db-mode.el ends here |