Commit | Line | Data |
---|---|---|
cea2906f CY |
1 | ;;; semantic/decorate/include.el --- Decoration modes for include statements |
2 | ||
49f70d46 | 3 | ;; Copyright (C) 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
cea2906f CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
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 | ;; Highlight any include that is in a state the user may care about. | |
25 | ;; The basic idea is to have the state be highly visible so users will | |
26 | ;; as 'what is this?" and get the info they need to fix problems that | |
45af56db | 27 | ;; are otherwise transparent when trying to get smart completion |
cea2906f CY |
28 | ;; working. |
29 | ||
30 | (require 'semantic/decorate/mode) | |
31 | (require 'semantic/db) | |
32 | (require 'semantic/db-ref) | |
33 | (require 'semantic/db-find) | |
34 | ||
35 | (eval-when-compile | |
36 | (require 'semantic/find)) | |
37 | ||
38 | (defvar semantic-dependency-system-include-path) | |
1fe1547a CY |
39 | (declare-function ede-get-locator-object "ede/files") |
40 | (declare-function ede-system-include-path "ede/cpp-root") | |
cea2906f CY |
41 | |
42 | ;;; Code: | |
43 | ||
44 | ;;; FACES AND KEYMAPS | |
45 | (defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ]) | |
46 | "The keybinding lisp object to use for binding the right mouse button.") | |
47 | ||
48 | ;;; Includes that that are in a happy state! | |
49 | ;; | |
50 | (defface semantic-decoration-on-includes | |
51 | nil | |
52 | "*Overlay Face used on includes that are not in some other state. | |
53 | Used by the decoration style: `semantic-decoration-on-includes'." | |
54 | :group 'semantic-faces) | |
55 | ||
56 | (defvar semantic-decoration-on-include-map | |
57 | (let ((km (make-sparse-keymap))) | |
58 | (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-include-menu) | |
59 | km) | |
60 | "Keymap used on includes.") | |
61 | ||
62 | ||
63 | (defvar semantic-decoration-on-include-menu nil | |
64 | "Menu used for include headers.") | |
65 | ||
66 | (easy-menu-define | |
67 | semantic-decoration-on-include-menu | |
68 | semantic-decoration-on-include-map | |
69 | "Include Menu" | |
70 | (list | |
71 | "Include" | |
72 | (semantic-menu-item | |
73 | ["What Is This?" semantic-decoration-include-describe | |
74 | :active t | |
75 | :help "Describe why this include has been marked this way." ]) | |
76 | (semantic-menu-item | |
77 | ["Visit This Include" semantic-decoration-include-visit | |
78 | :active t | |
79 | :help "Visit this include file." ]) | |
80 | "---" | |
81 | (semantic-menu-item | |
82 | ["Summarize includes current buffer" semantic-decoration-all-include-summary | |
83 | :active t | |
84 | :help "Show a summary for the current buffer containing this include." ]) | |
85 | (semantic-menu-item | |
86 | ["List found includes (load unparsed)" semanticdb-find-test-translate-path | |
87 | :active t | |
88 | :help "List all includes found for this file, and parse unparsed files." ]) | |
89 | (semantic-menu-item | |
90 | ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading | |
91 | :active t | |
92 | :help "List all includes found for this file, do not parse unparsed files." ]) | |
93 | (semantic-menu-item | |
94 | ["List all unknown includes" semanticdb-find-adebug-lost-includes | |
95 | :active t | |
96 | :help "Show a list of all includes semantic cannot find for this file." ]) | |
97 | "---" | |
98 | (semantic-menu-item | |
99 | ["Customize System Include Path" semantic-customize-system-include-path | |
100 | :active (get 'semantic-dependency-system-include-path major-mode) | |
101 | :help "Run customize for the system include path for this major mode." ]) | |
102 | (semantic-menu-item | |
103 | ["Add a System Include Path" semantic-add-system-include | |
104 | :active t | |
105 | :help "Add an include path for this session." ]) | |
106 | (semantic-menu-item | |
107 | ["Remove a System Include Path" semantic-remove-system-include | |
108 | :active t | |
109 | :help "Add an include path for this session." ]) | |
110 | ;;["" semantic-decoration-include- | |
111 | ;; :active t | |
112 | ;; :help "" ] | |
113 | )) | |
114 | ||
115 | ;;; Unknown Includes! | |
116 | ;; | |
117 | (defface semantic-decoration-on-unknown-includes | |
118 | '((((class color) (background dark)) | |
119 | (:background "#900000")) | |
120 | (((class color) (background light)) | |
dd9af436 | 121 | (:background "#fff0f0"))) |
cea2906f CY |
122 | "*Face used to show includes that cannot be found. |
123 | Used by the decoration style: `semantic-decoration-on-unknown-includes'." | |
124 | :group 'semantic-faces) | |
125 | ||
126 | (defvar semantic-decoration-on-unknown-include-map | |
127 | (let ((km (make-sparse-keymap))) | |
128 | ;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe) | |
129 | (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unknown-include-menu) | |
130 | km) | |
131 | "Keymap used on unparsed includes.") | |
132 | ||
133 | (defvar semantic-decoration-on-unknown-include-menu nil | |
134 | "Menu used for unparsed include headers.") | |
135 | ||
136 | (easy-menu-define | |
137 | semantic-decoration-on-unknown-include-menu | |
138 | semantic-decoration-on-unknown-include-map | |
139 | "Unknown Include Menu" | |
140 | (list | |
141 | "Unknown Include" | |
142 | (semantic-menu-item | |
143 | ["What Is This?" semantic-decoration-unknown-include-describe | |
144 | :active t | |
145 | :help "Describe why this include has been marked this way." ]) | |
146 | (semantic-menu-item | |
147 | ["List all unknown includes" semanticdb-find-adebug-lost-includes | |
148 | :active t | |
149 | :help "Show a list of all includes semantic cannot find for this file." ]) | |
150 | "---" | |
151 | (semantic-menu-item | |
152 | ["Summarize includes current buffer" semantic-decoration-all-include-summary | |
153 | :active t | |
154 | :help "Show a summary for the current buffer containing this include." ]) | |
155 | (semantic-menu-item | |
156 | ["List found includes (load unparsed)" semanticdb-find-test-translate-path | |
157 | :active t | |
158 | :help "List all includes found for this file, and parse unparsed files." ]) | |
159 | (semantic-menu-item | |
160 | ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading | |
161 | :active t | |
162 | :help "List all includes found for this file, do not parse unparsed files." ]) | |
163 | "---" | |
164 | (semantic-menu-item | |
165 | ["Customize System Include Path" semantic-customize-system-include-path | |
166 | :active (get 'semantic-dependency-system-include-path major-mode) | |
167 | :help "Run customize for the system include path for this major mode." ]) | |
168 | (semantic-menu-item | |
169 | ["Add a System Include Path" semantic-add-system-include | |
170 | :active t | |
171 | :help "Add an include path for this session." ]) | |
172 | (semantic-menu-item | |
173 | ["Remove a System Include Path" semantic-remove-system-include | |
174 | :active t | |
175 | :help "Add an include path for this session." ]) | |
176 | )) | |
177 | ||
178 | ;;; Includes that need to be parsed. | |
179 | ;; | |
180 | (defface semantic-decoration-on-unparsed-includes | |
181 | '((((class color) (background dark)) | |
182 | (:background "#555500")) | |
183 | (((class color) (background light)) | |
184 | (:background "#ffff55"))) | |
185 | "*Face used to show includes that have not yet been parsed. | |
186 | Used by the decoration style: `semantic-decoration-on-unparsed-includes'." | |
187 | :group 'semantic-faces) | |
188 | ||
189 | (defvar semantic-decoration-on-unparsed-include-map | |
190 | (let ((km (make-sparse-keymap))) | |
191 | (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu) | |
192 | km) | |
193 | "Keymap used on unparsed includes.") | |
194 | ||
195 | ||
196 | (defvar semantic-decoration-on-unparsed-include-menu nil | |
197 | "Menu used for unparsed include headers.") | |
198 | ||
199 | (easy-menu-define | |
200 | semantic-decoration-on-unparsed-include-menu | |
201 | semantic-decoration-on-unparsed-include-map | |
202 | "Unparsed Include Menu" | |
203 | (list | |
204 | "Unparsed Include" | |
205 | (semantic-menu-item | |
206 | ["What Is This?" semantic-decoration-unparsed-include-describe | |
207 | :active t | |
208 | :help "Describe why this include has been marked this way." ]) | |
209 | (semantic-menu-item | |
210 | ["Visit This Include" semantic-decoration-include-visit | |
211 | :active t | |
212 | :help "Visit this include file so that header file's tags can be used." ]) | |
213 | (semantic-menu-item | |
214 | ["Parse This Include" semantic-decoration-unparsed-include-parse-include | |
215 | :active t | |
216 | :help "Parse this include file so that header file's tags can be used." ]) | |
217 | (semantic-menu-item | |
218 | ["Parse All Includes" semantic-decoration-unparsed-include-parse-all-includes | |
219 | :active t | |
220 | :help "Parse all the includes so the contents can be used." ]) | |
221 | "---" | |
222 | (semantic-menu-item | |
223 | ["Summarize includes current buffer" semantic-decoration-all-include-summary | |
224 | :active t | |
225 | :help "Show a summary for the current buffer containing this include." ]) | |
226 | (semantic-menu-item | |
227 | ["List found includes (load unparsed)" semanticdb-find-test-translate-path | |
228 | :active t | |
229 | :help "List all includes found for this file, and parse unparsed files." ]) | |
230 | (semantic-menu-item | |
231 | ["List found includes (no loading)" semanticdb-find-test-translate-path-no-loading | |
232 | :active t | |
233 | :help "List all includes found for this file, do not parse unparsed files." ]) | |
234 | (semantic-menu-item | |
235 | ["List all unknown includes" semanticdb-find-adebug-lost-includes | |
236 | :active t | |
237 | :help "Show a list of all includes semantic cannot find for this file." ]) | |
238 | "---" | |
239 | (semantic-menu-item | |
240 | ["Customize System Include Path" semantic-customize-system-include-path | |
241 | :active (get 'semantic-dependency-system-include-path major-mode) | |
242 | :help "Run customize for the system include path for this major mode." ]) | |
243 | (semantic-menu-item | |
244 | ["Add a System Include Path" semantic-add-system-include | |
245 | :active t | |
246 | :help "Add an include path for this session." ]) | |
247 | (semantic-menu-item | |
248 | ["Remove a System Include Path" semantic-remove-system-include | |
249 | :active t | |
250 | :help "Add an include path for this session." ]) | |
251 | ;;["" semantic-decoration-unparsed-include- | |
252 | ;; :active t | |
253 | ;; :help "" ] | |
254 | )) | |
255 | ||
256 | \f | |
257 | ;;; MODES | |
258 | ||
259 | ;;; Include statement Decorate Mode | |
260 | ;; | |
261 | ;; This mode handles the three states of an include statements | |
262 | ;; | |
263 | (define-semantic-decoration-style semantic-decoration-on-includes | |
264 | "Highlight class members that are includes. | |
265 | This mode provides a nice context menu on the include statements." | |
266 | :enabled t) | |
267 | ||
268 | (defun semantic-decoration-on-includes-p-default (tag) | |
269 | "Return non-nil if TAG has is an includes that can't be found." | |
270 | (semantic-tag-of-class-p tag 'include)) | |
271 | ||
272 | (defun semantic-decoration-on-includes-highlight-default (tag) | |
273 | "Highlight the include TAG to show that semantic can't find it." | |
274 | (let* ((file (semantic-dependency-tag-file tag)) | |
275 | (table (when file | |
276 | (semanticdb-file-table-object file t))) | |
277 | (face nil) | |
278 | (map nil) | |
279 | ) | |
280 | (cond | |
281 | ((not file) | |
282 | ;; Cannot find this header. | |
283 | (setq face 'semantic-decoration-on-unknown-includes | |
284 | map semantic-decoration-on-unknown-include-map) | |
285 | ) | |
286 | ((and table (number-or-marker-p (oref table pointmax))) | |
287 | ;; A found and parsed file. | |
288 | (setq face 'semantic-decoration-on-includes | |
289 | map semantic-decoration-on-include-map) | |
290 | ) | |
291 | (t | |
292 | ;; An unparsed file. | |
293 | (setq face 'semantic-decoration-on-unparsed-includes | |
294 | map semantic-decoration-on-unparsed-include-map) | |
295 | (when table | |
296 | ;; Set ourselves up for synchronization | |
297 | (semanticdb-cache-get | |
298 | table 'semantic-decoration-unparsed-include-cache) | |
299 | ;; Add a dependancy. | |
300 | (let ((table semanticdb-current-table)) | |
301 | (semanticdb-add-reference table tag)) | |
302 | ) | |
303 | )) | |
304 | ||
dd9af436 CY |
305 | ;; @TODO - if not a tag w/ a position, we need to get one. How? |
306 | ||
307 | (when (semantic-tag-with-position-p tag) | |
308 | (let ((ol (semantic-decorate-tag tag | |
309 | (semantic-tag-start tag) | |
310 | (semantic-tag-end tag) | |
311 | face)) | |
312 | ) | |
313 | (semantic-overlay-put ol 'mouse-face 'highlight) | |
314 | (semantic-overlay-put ol 'keymap map) | |
315 | (semantic-overlay-put ol 'help-echo | |
316 | "Header File : mouse-3 - Context menu") | |
317 | )))) | |
cea2906f CY |
318 | |
319 | ;;; Regular Include Functions | |
320 | ;; | |
321 | (defun semantic-decoration-include-describe () | |
322 | "Describe what unparsed includes are in the current buffer. | |
323 | Argument EVENT is the mouse clicked event." | |
324 | (interactive) | |
325 | (let* ((tag (or (semantic-current-tag) | |
326 | (error "No tag under point"))) | |
327 | (file (semantic-dependency-tag-file tag)) | |
328 | (table (when file | |
329 | (semanticdb-file-table-object file t)))) | |
330 | (with-output-to-temp-buffer (help-buffer) ; "*Help*" | |
331 | (help-setup-xref (list #'semantic-decoration-include-describe) | |
2054a44c | 332 | (called-interactively-p 'interactive)) |
cea2906f CY |
333 | (princ "Include File: ") |
334 | (princ (semantic-format-tag-name tag nil t)) | |
335 | (princ "\n") | |
336 | (princ "This include file was found at:\n ") | |
337 | (princ (semantic-dependency-tag-file tag)) | |
338 | (princ "\n\n") | |
339 | (princ "Semantic knows where this include file is, and has parsed | |
340 | its contents. | |
341 | ||
342 | ") | |
343 | (let ((inc (semantic-find-tags-by-class 'include table)) | |
344 | (ok 0) | |
345 | (unknown 0) | |
346 | (unparsed 0) | |
347 | (all 0)) | |
348 | (dolist (i inc) | |
349 | (let* ((fileinner (semantic-dependency-tag-file i)) | |
350 | ) | |
351 | (cond ((not fileinner) | |
352 | (setq unknown (1+ unknown))) | |
353 | ((number-or-marker-p (oref table pointmax)) | |
354 | (setq ok (1+ ok))) | |
355 | (t | |
356 | (setq unparsed (1+ unparsed)))))) | |
357 | (setq all (+ ok unknown unparsed)) | |
358 | (if (= 0 all) | |
359 | (princ "There are no other includes in this file.\n") | |
360 | (princ (format "There are %d more includes in this file.\n" | |
361 | all)) | |
362 | (princ (format " Unknown Includes: %d\n" unknown)) | |
363 | (princ (format " Unparsed Includes: %d\n" unparsed)) | |
364 | (princ (format " Parsed Includes: %d\n" ok))) | |
365 | ) | |
366 | ;; Get the semanticdb statement, and display it's contents. | |
367 | (princ "\nDetails for header file...\n") | |
368 | (princ "\nMajor Mode: ") | |
369 | (princ (oref table :major-mode)) | |
370 | (princ "\nTags: ") | |
371 | (princ (format "%s entries" (length (oref table :tags)))) | |
372 | (princ "\nFile Size: ") | |
373 | (princ (format "%s chars" (oref table :pointmax))) | |
374 | (princ "\nSave State: ") | |
375 | (cond ((oref table dirty) | |
376 | (princ "Table needs to be saved.")) | |
377 | (t | |
378 | (princ "Table is saved on disk.")) | |
379 | ) | |
380 | (princ "\nExternal References:") | |
381 | (dolist (r (oref table db-refs)) | |
382 | (princ "\n ") | |
383 | (princ (oref r file))) | |
384 | ))) | |
385 | ||
d7576f17 | 386 | ;;;###autoload |
cea2906f CY |
387 | (defun semantic-decoration-include-visit () |
388 | "Visit the included file at point." | |
389 | (interactive) | |
390 | (let ((tag (semantic-current-tag))) | |
391 | (unless (eq (semantic-tag-class tag) 'include) | |
392 | (error "Point is not on an include tag")) | |
393 | (let ((file (semantic-dependency-tag-file tag))) | |
394 | (cond | |
395 | ((or (not file) (not (file-exists-p file))) | |
396 | (error "Could not location include %s" | |
397 | (semantic-tag-name tag))) | |
398 | ((get-file-buffer file) | |
399 | (switch-to-buffer (get-file-buffer file))) | |
400 | ((stringp file) | |
401 | (find-file file)) | |
402 | )))) | |
403 | ||
404 | (defun semantic-decoration-include-menu (event) | |
405 | "Popup a menu that can help a user understand unparsed includes. | |
406 | Argument EVENT describes the event that caused this function to be called." | |
407 | (interactive "e") | |
408 | (let* ((startwin (selected-window)) | |
409 | (win (semantic-event-window event)) | |
410 | ) | |
411 | (select-window win t) | |
412 | (save-excursion | |
413 | ;(goto-char (window-start win)) | |
414 | (mouse-set-point event) | |
415 | (sit-for 0) | |
416 | (semantic-popup-menu semantic-decoration-on-include-menu) | |
417 | ) | |
418 | (select-window startwin))) | |
419 | ||
420 | \f | |
421 | ;;; Unknown Include functions | |
422 | ;; | |
423 | (defun semantic-decoration-unknown-include-describe () | |
424 | "Describe what unknown includes are in the current buffer. | |
425 | Argument EVENT is the mouse clicked event." | |
426 | (interactive) | |
427 | (let ((tag (semantic-current-tag)) | |
428 | (mm major-mode)) | |
429 | (with-output-to-temp-buffer (help-buffer) ; "*Help*" | |
430 | (help-setup-xref (list #'semantic-decoration-unknown-include-describe) | |
2054a44c | 431 | (called-interactively-p 'interactive)) |
cea2906f CY |
432 | (princ "Include File: ") |
433 | (princ (semantic-format-tag-name tag nil t)) | |
434 | (princ "\n\n") | |
435 | (princ "This header file has been marked \"Unknown\". | |
436 | This means that Semantic has not been able to locate this file on disk. | |
437 | ||
438 | When Semantic cannot find an include file, this means that the | |
439 | idle summary mode and idle completion modes cannot use the contents of | |
440 | that file to provide coding assistance. | |
441 | ||
442 | If this is a system header and you want it excluded from Semantic's | |
443 | searches (which may be desirable for speed reasons) then you can | |
444 | safely ignore this state. | |
445 | ||
446 | If this is a system header, and you want to include it in Semantic's | |
447 | searches, then you will need to use: | |
448 | ||
449 | M-x semantic-add-system-include RET /path/to/includes RET | |
450 | ||
451 | or, in your .emacs file do: | |
452 | ||
453 | (semantic-add-system-include \"/path/to/include\" '") | |
454 | (princ (symbol-name mm)) | |
455 | (princ ") | |
456 | ||
457 | to add the path to Semantic's search. | |
458 | ||
459 | If this is an include file that belongs to your project, then you may | |
460 | need to update `semanticdb-project-roots' or better yet, use `ede' | |
461 | to manage your project. See the ede manual for projects that will | |
462 | wrap existing project code for Semantic's benifit. | |
463 | ") | |
464 | ||
465 | (when (or (eq mm 'c++-mode) (eq mm 'c-mode)) | |
466 | (princ " | |
045b9da7 | 467 | For C/C++ includes located within a project, you can use a special |
cea2906f CY |
468 | EDE project that will wrap an existing build system. You can do that |
469 | like this in your .emacs file: | |
470 | ||
471 | (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN) | |
472 | ||
473 | See the CEDET manual, the EDE manual, or the commentary in | |
474 | ede-cpp-root.el for more. | |
475 | ||
476 | If you think this header tag is marked in error, you may need to do: | |
477 | ||
478 | C-u M-x bovinate RET | |
479 | ||
480 | to refresh the tags in this buffer, and recalculate the state.")) | |
481 | ||
482 | (princ " | |
483 | See the Semantic manual node on SemanticDB for more about search paths.") | |
484 | ))) | |
485 | ||
486 | (defun semantic-decoration-unknown-include-menu (event) | |
487 | "Popup a menu that can help a user understand unparsed includes. | |
488 | Argument EVENT describes the event that caused this function to be called." | |
489 | (interactive "e") | |
490 | (let* ((startwin (selected-window)) | |
491 | ;; This line has an issue in XEmacs. | |
492 | (win (semantic-event-window event)) | |
493 | ) | |
494 | (select-window win t) | |
495 | (save-excursion | |
496 | ;(goto-char (window-start win)) | |
497 | (mouse-set-point event) | |
498 | (sit-for 0) | |
499 | (semantic-popup-menu semantic-decoration-on-unknown-include-menu) | |
500 | ) | |
501 | (select-window startwin))) | |
502 | ||
503 | \f | |
504 | ;;; Interactive parts of unparsed includes | |
505 | ;; | |
506 | (defun semantic-decoration-unparsed-include-describe () | |
507 | "Describe what unparsed includes are in the current buffer. | |
508 | Argument EVENT is the mouse clicked event." | |
509 | (interactive) | |
510 | (let ((tag (semantic-current-tag))) | |
511 | (with-output-to-temp-buffer (help-buffer); "*Help*" | |
512 | (help-setup-xref (list #'semantic-decoration-unparsed-include-describe) | |
2054a44c | 513 | (called-interactively-p 'interactive)) |
cea2906f CY |
514 | |
515 | (princ "Include File: ") | |
516 | (princ (semantic-format-tag-name tag nil t)) | |
517 | (princ "\n") | |
518 | (princ "This include file was found at:\n ") | |
519 | (princ (semantic-dependency-tag-file tag)) | |
520 | (princ "\n\n") | |
521 | (princ "This header file has been marked \"Unparsed\". | |
522 | This means that Semantic has located this header file on disk | |
523 | but has not yet opened and parsed this file. | |
524 | ||
525 | So long as this header file is unparsed, idle summary and | |
526 | idle completion will not be able to reference the details in this | |
527 | header. | |
528 | ||
529 | To resolve this, use the context menu to parse this include file, | |
530 | or all include files referred to in ") | |
531 | (princ (buffer-name)) | |
532 | (princ ". | |
533 | This can take a while in large projects. | |
534 | ||
535 | Alternately, you can call: | |
536 | ||
537 | M-x semanticdb-find-test-translate-path RET | |
538 | ||
539 | to search path Semantic uses to perform completion. | |
540 | ||
541 | ||
542 | If you think this header tag is marked in error, you may need to do: | |
543 | ||
544 | C-u M-x bovinate RET | |
545 | ||
546 | to refresh the tags in this buffer, and recalculate the state. | |
547 | If you find a repeatable case where a header is marked in error, | |
548 | report it to cedet-devel@lists.sf.net.") ))) | |
549 | ||
550 | ||
551 | (defun semantic-decoration-unparsed-include-menu (event) | |
552 | "Popup a menu that can help a user understand unparsed includes. | |
553 | Argument EVENT describes the event that caused this function to be called." | |
554 | (interactive "e") | |
555 | (let* ((startwin (selected-window)) | |
556 | (win (semantic-event-window event)) | |
557 | ) | |
558 | (select-window win t) | |
559 | (save-excursion | |
560 | ;(goto-char (window-start win)) | |
561 | (mouse-set-point event) | |
562 | (sit-for 0) | |
563 | (semantic-popup-menu semantic-decoration-on-unparsed-include-menu) | |
564 | ) | |
565 | (select-window startwin))) | |
566 | ||
567 | (defun semantic-decoration-unparsed-include-parse-include () | |
568 | "Parse the include file the user menu-selected from." | |
569 | (interactive) | |
570 | (let* ((file (semantic-dependency-tag-file (semantic-current-tag)))) | |
571 | (semanticdb-file-table-object file) | |
572 | (semantic-decoration-unparsed-include-do-reset))) | |
573 | ||
574 | ||
575 | (defun semantic-decoration-unparsed-include-parse-all-includes () | |
576 | "Parse the include file the user menu-selected from." | |
577 | (interactive) | |
578 | (semanticdb-find-translate-path nil nil) | |
579 | ) | |
580 | ||
581 | \f | |
582 | ;;; General Includes Information | |
583 | ;; | |
584 | (defun semantic-decoration-all-include-summary () | |
585 | "Provide a general summary for the state of all includes." | |
586 | (interactive) | |
587 | (require 'semantic/dep) | |
588 | (let* ((table semanticdb-current-table) | |
589 | (tags (semantic-fetch-tags)) | |
590 | (inc (semantic-find-tags-by-class 'include table)) | |
591 | ) | |
592 | (with-output-to-temp-buffer (help-buffer) ;"*Help*" | |
593 | (help-setup-xref (list #'semantic-decoration-all-include-summary) | |
2054a44c | 594 | (called-interactively-p 'interactive)) |
cea2906f CY |
595 | |
596 | (princ "Include Summary for File: ") | |
597 | (princ (file-truename (buffer-file-name))) | |
598 | (princ "\n") | |
599 | ||
600 | (when (oref table db-refs) | |
601 | (princ "\nExternal Database References to this buffer:") | |
602 | (dolist (r (oref table db-refs)) | |
603 | (princ "\n ") | |
604 | (princ (oref r file))) | |
605 | ) | |
606 | ||
607 | (princ (format "\nThis file contains %d tags, %d of which are includes.\n" | |
608 | (length tags) (length inc))) | |
609 | (let ((ok 0) | |
610 | (unknown 0) | |
611 | (unparsed 0) | |
612 | (all 0)) | |
613 | (dolist (i inc) | |
614 | (let* ((fileinner (semantic-dependency-tag-file i)) | |
615 | (tableinner (when fileinner | |
616 | (semanticdb-file-table-object fileinner t)))) | |
617 | (cond ((not fileinner) | |
618 | (setq unknown (1+ unknown))) | |
619 | ((number-or-marker-p (oref tableinner pointmax)) | |
620 | (setq ok (1+ ok))) | |
621 | (t | |
622 | (setq unparsed (1+ unparsed)))))) | |
623 | (setq all (+ ok unknown unparsed)) | |
624 | (when (not (= 0 all)) | |
625 | (princ (format " Unknown Includes: %d\n" unknown)) | |
626 | (princ (format " Unparsed Includes: %d\n" unparsed)) | |
627 | (princ (format " Parsed Includes: %d\n" ok))) | |
628 | ) | |
629 | ||
630 | (princ "\nInclude Path Summary:\n\n") | |
1fe1547a CY |
631 | (when (and (boundp 'ede-object) |
632 | (boundp 'ede-object-project) | |
633 | ede-object) | |
cea2906f CY |
634 | (princ " This file's project include search is handled by the EDE object:\n") |
635 | (princ " Buffer Target: ") | |
636 | (princ (object-print ede-object)) | |
637 | (princ "\n") | |
638 | (when (not (eq ede-object ede-object-project)) | |
639 | (princ " Buffer Project: ") | |
640 | (princ (object-print ede-object-project)) | |
641 | (princ "\n") | |
642 | ) | |
643 | (when ede-object-project | |
644 | (let ((loc (ede-get-locator-object ede-object-project))) | |
645 | (princ " Backup in-project Locator: ") | |
646 | (princ (object-print loc)) | |
647 | (princ "\n"))) | |
648 | (let ((syspath (ede-system-include-path ede-object-project))) | |
649 | (if (not syspath) | |
650 | (princ " EDE Project system include path: Empty\n") | |
651 | (princ " EDE Project system include path:\n") | |
652 | (dolist (dir syspath) | |
653 | (princ " ") | |
654 | (princ dir) | |
655 | (princ "\n")) | |
656 | ))) | |
657 | ||
658 | (princ "\n This file's system include path is:\n") | |
659 | (dolist (dir semantic-dependency-system-include-path) | |
660 | (princ " ") | |
661 | (princ dir) | |
662 | (princ "\n")) | |
663 | ||
664 | (let ((unk semanticdb-find-lost-includes)) | |
665 | (when unk | |
666 | (princ "\nAll unknown includes:\n") | |
667 | (dolist (tag unk) | |
668 | (princ " ") | |
669 | (princ (semantic-tag-name tag)) | |
670 | (princ "\n")) | |
671 | )) | |
672 | ||
673 | (let* ((semanticdb-find-default-throttle | |
a60f2e7b | 674 | (if (featurep 'semantic/db-find) |
cea2906f CY |
675 | (remq 'unloaded semanticdb-find-default-throttle) |
676 | nil)) | |
677 | (path (semanticdb-find-translate-path nil nil))) | |
678 | (if (<= (length path) (length inc)) | |
679 | (princ "\nThere are currently no includes found recursively.\n") | |
680 | ;; List the full include list. | |
681 | (princ "\nSummary of all includes needed by ") | |
682 | (princ (buffer-name)) | |
683 | (dolist (p path) | |
684 | (if (slot-boundp p 'tags) | |
685 | (princ (format "\n %s :\t%d tags, %d are includes. %s" | |
686 | (object-name-string p) | |
687 | (length (oref p tags)) | |
688 | (length (semantic-find-tags-by-class | |
689 | 'include p)) | |
690 | (cond | |
691 | ((condition-case nil | |
692 | (oref p dirty) | |
693 | (error nil)) | |
694 | " dirty.") | |
695 | ((not (number-or-marker-p (oref table pointmax))) | |
696 | " Needs to be parsed.") | |
697 | (t "")))) | |
698 | (princ (format "\n %s :\tUnparsed" | |
699 | (object-name-string p)))) | |
700 | ))) | |
701 | ))) | |
702 | ||
703 | \f | |
704 | ;;; Unparsed Include Features | |
705 | ;; | |
706 | ;; This section handles changing states of unparsed include | |
707 | ;; decorations base on what happens in other files. | |
708 | ;; | |
709 | ||
710 | (defclass semantic-decoration-unparsed-include-cache (semanticdb-abstract-cache) | |
711 | () | |
712 | "Class used to reset decorated includes. | |
713 | When an include's referring file is parsed, we need to undecorate | |
714 | any decorated referring includes.") | |
715 | ||
716 | ||
717 | (defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache)) | |
718 | "Reset OBJ back to it's empty settings." | |
719 | (let ((table (oref obj table))) | |
720 | ;; This is a hack. Add in something better? | |
721 | (semanticdb-notify-references | |
722 | table (lambda (tab me) | |
723 | (semantic-decoration-unparsed-include-refrence-reset tab) | |
724 | )) | |
725 | )) | |
726 | ||
727 | (defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache) | |
728 | new-tags) | |
729 | "Synchronize CACHE with some NEW-TAGS." | |
730 | (if (semantic-find-tags-by-class 'include new-tags) | |
731 | (semantic-reset cache))) | |
732 | ||
733 | (defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache) | |
734 | new-tags) | |
735 | "Synchronize a CACHE with some NEW-TAGS." | |
736 | (semantic-reset cache)) | |
737 | ||
738 | (defun semantic-decoration-unparsed-include-refrence-reset (table) | |
739 | "Refresh any highlighting in buffers referred to by TABLE. | |
740 | If TABLE is not in a buffer, do nothing." | |
741 | ;; This cache removal may seem odd in that we are "creating one", but | |
742 | ;; since we cant get in the fcn unless one exists, this ought to be | |
743 | ;; ok. | |
744 | (let ((c (semanticdb-cache-get | |
745 | table 'semantic-decoration-unparsed-include-cache))) | |
746 | (semanticdb-cache-remove table c)) | |
747 | ||
748 | (let ((buf (semanticdb-in-buffer-p table))) | |
749 | (when buf | |
750 | (semantic-decorate-add-pending-decoration | |
751 | 'semantic-decoration-unparsed-include-do-reset | |
752 | buf) | |
753 | ))) | |
754 | ||
d7576f17 | 755 | ;;;###autoload |
cea2906f CY |
756 | (defun semantic-decoration-unparsed-include-do-reset () |
757 | "Do a reset of unparsed includes in the current buffer." | |
758 | (let* ((style (assoc "semantic-decoration-on-includes" | |
759 | semantic-decoration-styles))) | |
760 | (when (cdr style) | |
761 | (let ((allinc (semantic-find-tags-included | |
762 | (semantic-fetch-tags-fast)))) | |
763 | ;; This will do everything, but it should be speedy since it | |
764 | ;; would have been done once already. | |
765 | (semantic-decorate-add-decorations allinc) | |
766 | )))) | |
767 | ||
768 | ||
769 | (provide 'semantic/decorate/include) | |
770 | ||
d7576f17 CY |
771 | ;; Local variables: |
772 | ;; generated-autoload-file: "../loaddefs.el" | |
d7576f17 CY |
773 | ;; generated-autoload-load-name: "semantic/decorate/include" |
774 | ;; End: | |
775 | ||
3999968a | 776 | ;; arch-tag: c3277137-be3f-43e2-af89-3b14b9bd7479 |
cea2906f | 777 | ;;; semantic/decorate/include.el ends here |