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