Spelling fixes.
[bpt/emacs.git] / lisp / cedet / semantic / bovine / c.el
CommitLineData
4feec2f5
CY
1;;; semantic/bovine/c.el --- Semantic details for C
2
73b0cd50 3;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
4feec2f5
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;; Support for the C/C++ bovine parser for Semantic.
25;;
26;; @todo - can I support c++-font-lock-extra-types ?
27
28(require 'semantic)
29(require 'semantic/analyze)
30(require 'semantic/bovine/gcc)
4feec2f5
CY
31(require 'semantic/idle)
32(require 'semantic/lex-spp)
4feec2f5
CY
33(require 'semantic/bovine/c-by)
34
35(eval-when-compile
4feec2f5
CY
36 (require 'semantic/find))
37
38(declare-function semantic-brute-find-tag-by-attribute "semantic/find")
39(declare-function semanticdb-minor-mode-p "semantic/db-mode")
4feec2f5 40(declare-function semanticdb-needs-refresh-p "semantic/db")
dd9af436 41(declare-function semanticdb-typecache-faux-namespace "semantic/db-typecache")
4feec2f5 42(declare-function c-forward-conditional "cc-cmds")
1fe1547a 43(declare-function ede-system-include-path "ede")
4feec2f5
CY
44
45;;; Compatibility
46;;
47(eval-when-compile (require 'cc-mode))
48
49(if (fboundp 'c-end-of-macro)
50 (eval-and-compile
51 (defalias 'semantic-c-end-of-macro 'c-end-of-macro))
52 ;; From cc-mode 5.30
53 (defun semantic-c-end-of-macro ()
54 "Go to the end of a preprocessor directive.
55More accurately, move point to the end of the closest following line
56that doesn't end with a line continuation backslash.
57
58This function does not do any hidden buffer changes."
59 (while (progn
60 (end-of-line)
61 (when (and (eq (char-before) ?\\)
62 (not (eobp)))
63 (forward-char)
64 t))))
65 )
66
67;;; Code:
68(define-child-mode c++-mode c-mode
69 "`c++-mode' uses the same parser as `c-mode'.")
70
71\f
72;;; Include Paths
73;;
74(defcustom-mode-local-semantic-dependency-system-include-path
75 c-mode semantic-c-dependency-system-include-path
76 '("/usr/include")
91abaf51 77 "The system include path used by the C language.")
4feec2f5
CY
78
79(defcustom semantic-default-c-path nil
80 "Default set of include paths for C code.
81Used by `semantic-dep' to define an include path.
82NOTE: In process of obsoleting this."
83 :group 'c
84 :group 'semantic
85 :type '(repeat (string :tag "Path")))
86
87(defvar-mode-local c-mode semantic-dependency-include-path
88 semantic-default-c-path
89 "System path to search for include files.")
90
91;;; Compile Options
92;;
93;; Compiler options need to show up after path setup, but before
94;; the preprocessor section.
95
72bc50c0
GM
96(if (memq system-type '(gnu gnu/linux darwin cygwin))
97 (semantic-gcc-setup))
4feec2f5
CY
98
99;;; Pre-processor maps
100;;
101;;; Lexical analysis
102(defvar semantic-lex-c-preprocessor-symbol-map-builtin
103 '( ("__THROW" . "")
104 ("__const" . "const")
105 ("__restrict" . "")
106 ("__declspec" . ((spp-arg-list ("foo") 1 . 2)))
107 ("__attribute__" . ((spp-arg-list ("foo") 1 . 2)))
108 )
109 "List of symbols to include by default.")
110
111(defvar semantic-c-in-reset-preprocessor-table nil
112 "Non-nil while resetting the preprocessor symbol map.
113Used to prevent a reset while trying to parse files that are
114part of the preprocessor map.")
115
116(defvar semantic-lex-c-preprocessor-symbol-file)
117(defvar semantic-lex-c-preprocessor-symbol-map)
118
119(defun semantic-c-reset-preprocessor-symbol-map ()
120 "Reset the C preprocessor symbol map based on all input variables."
a60f2e7b 121 (when (featurep 'semantic/bovine/c)
4feec2f5
CY
122 (let ((filemap nil)
123 )
124 (when (and (not semantic-c-in-reset-preprocessor-table)
125 (featurep 'semantic/db-mode)
126 (semanticdb-minor-mode-p))
127 (let ( ;; Don't use external parsers. We need the internal one.
128 (semanticdb-out-of-buffer-create-table-fcn nil)
129 ;; Don't recurse while parsing these files the first time.
130 (semantic-c-in-reset-preprocessor-table t)
131 )
132 (dolist (sf semantic-lex-c-preprocessor-symbol-file)
133 ;; Global map entries
134 (let* ((table (semanticdb-file-table-object sf t)))
135 (when table
136 (when (semanticdb-needs-refresh-p table)
137 (condition-case nil
138 ;; Call with FORCE, as the file is very likely to
139 ;; not be in a buffer.
140 (semanticdb-refresh-table table t)
141 (error (message "Error updating tables for %S"
142 (object-name table)))))
143 (setq filemap (append filemap (oref table lexical-table)))
144 )
145 ))))
146
147 (setq-mode-local c-mode
148 semantic-lex-spp-macro-symbol-obarray
149 (semantic-lex-make-spp-table
150 (append semantic-lex-c-preprocessor-symbol-map-builtin
151 semantic-lex-c-preprocessor-symbol-map
152 filemap))
153 )
154 )))
155
156(defcustom semantic-lex-c-preprocessor-symbol-map nil
157 "Table of C Preprocessor keywords used by the Semantic C lexer.
158Each entry is a cons cell like this:
159 ( \"KEYWORD\" . \"REPLACEMENT\" )
160Where KEYWORD is the macro that gets replaced in the lexical phase,
dd9af436 161and REPLACEMENT is a string that is inserted in its place. Empty string
4feec2f5
CY
162implies that the lexical analyzer will discard KEYWORD when it is encountered.
163
164Alternately, it can be of the form:
165 ( \"KEYWORD\" ( LEXSYM1 \"str\" 1 1 ) ... ( LEXSYMN \"str\" 1 1 ) )
166where LEXSYM is a symbol that would normally be produced by the
167lexical analyzer, such as `symbol' or `string'. The string in the
168second position is the text that makes up the replacement. This is
169the way to have multiple lexical symbols in a replacement. Using the
170first way to specify text like \"foo::bar\" would not work, because :
9bf6c65c 171is a separate lexical symbol.
4feec2f5
CY
172
173A quick way to see what you would need to insert is to place a
174definition such as:
175
176#define MYSYM foo::bar
177
178into a C file, and do this:
179 \\[semantic-lex-spp-describe]
180
181The output table will describe the symbols needed."
182 :group 'c
183 :type '(repeat (cons (string :tag "Keyword")
184 (sexp :tag "Replacement")))
185 :set (lambda (sym value)
186 (set-default sym value)
187 (condition-case nil
188 (semantic-c-reset-preprocessor-symbol-map)
189 (error nil))
190 )
191 )
192
193(defcustom semantic-lex-c-preprocessor-symbol-file nil
194 "List of C/C++ files that contain preprocessor macros for the C lexer.
195Each entry is a filename and each file is parsed, and those macros
196are included in every C/C++ file parsed by semantic.
197You can use this variable instead of `semantic-lex-c-preprocessor-symbol-map'
198to store your global macros in a more natural way."
199 :group 'c
200 :type '(repeat (file :tag "File"))
201 :set (lambda (sym value)
202 (set-default sym value)
203 (condition-case nil
204 (semantic-c-reset-preprocessor-symbol-map)
205 (error nil))
206 )
207 )
208
209(defcustom semantic-c-member-of-autocast 't
91abaf51 210 "Non-nil means classes with a '->' operator will cast to its return type.
4feec2f5
CY
211
212For Examples:
213
214 class Foo {
215 Bar *operator->();
216 }
217
218 Foo foo;
219
220if `semantic-c-member-of-autocast' is non-nil :
221 foo->[here completion will list method of Bar]
222
223if `semantic-c-member-of-autocast' is nil :
224 foo->[here completion will list method of Foo]"
225 :group 'c
226 :type 'boolean)
227
228(define-lex-spp-macro-declaration-analyzer semantic-lex-cpp-define
229 "A #define of a symbol with some value.
230Record the symbol in the semantic preprocessor.
a30e71ae 231Return the defined symbol as a special spp lex token."
4feec2f5
CY
232 "^\\s-*#\\s-*define\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1
233 (goto-char (match-end 0))
234 (skip-chars-forward " \t")
235 (if (eolp)
236 nil
237 (let* ((name (buffer-substring-no-properties
238 (match-beginning 1) (match-end 1)))
239 (with-args (save-excursion
240 (goto-char (match-end 0))
241 (looking-at "(")))
242 (semantic-lex-spp-replacements-enabled nil)
8350f087 243 ;; Temporarily override the lexer to include
4feec2f5
CY
244 ;; special items needed inside a macro
245 (semantic-lex-analyzer #'semantic-cpp-lexer)
246 (raw-stream
247 (semantic-lex-spp-stream-for-macro (save-excursion
248 (semantic-c-end-of-macro)
249 (point))))
250 )
251
40a8bdf6 252 ;; Only do argument checking if the paren was immediately after
4feec2f5
CY
253 ;; the macro name.
254 (if with-args
255 (semantic-lex-spp-first-token-arg-list (car raw-stream)))
256
257 ;; Magical spp variable for end point.
258 (setq semantic-lex-end-point (point))
259
260 ;; Handled nested macro streams.
261 (semantic-lex-spp-merge-streams raw-stream)
262 )))
263
264(define-lex-spp-macro-undeclaration-analyzer semantic-lex-cpp-undef
265 "A #undef of a symbol.
266Remove the symbol from the semantic preprocessor.
a30e71ae 267Return the defined symbol as a special spp lex token."
4feec2f5
CY
268 "^\\s-*#\\s-*undef\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1)
269
270\f
271;;; Conditional Skipping
272;;
273(defcustom semantic-c-obey-conditional-section-parsing-flag t
274 "*Non-nil means to interpret preprocessor #if sections.
275This implies that some blocks of code will not be parsed based on the
276values of the conditions in the #if blocks."
277 :group 'c
278 :type 'boolean)
279
280(defun semantic-c-skip-conditional-section ()
281 "Skip one section of a conditional.
282Moves forward to a matching #elif, #else, or #endif.
29e1a603 283Moves completely over balanced #if blocks."
4feec2f5
CY
284 (require 'cc-cmds)
285 (let ((done nil))
286 ;; (if (looking-at "^\\s-*#if")
287 ;; (semantic-lex-spp-push-if (point))
288 (end-of-line)
289 (while (and semantic-c-obey-conditional-section-parsing-flag
290 (and (not done)
291 (re-search-forward
292 "^\\s-*#\\s-*\\(if\\(n?def\\)?\\|el\\(if\\|se\\)\\|endif\\)\\>"
293 nil t)))
294 (goto-char (match-beginning 0))
295 (cond
296 ((looking-at "^\\s-*#\\s-*if")
297 ;; We found a nested if. Skip it.
dd9af436 298 ;; @TODO - can we use the new c-scan-conditionals
4feec2f5
CY
299 (c-forward-conditional 1))
300 ((looking-at "^\\s-*#\\s-*elif")
301 ;; We need to let the preprocessor analize this one.
302 (beginning-of-line)
303 (setq done t)
304 )
305 ((looking-at "^\\s-*#\\s-*\\(endif\\|else\\)\\>")
306 ;; We are at the end. Pop our state.
307 ;; (semantic-lex-spp-pop-if)
308 ;; Note: We include ELSE and ENDIF the same. If skip some previous
309 ;; section, then we should do the else by default, making it much
310 ;; like the endif.
311 (end-of-line)
312 (forward-char 1)
313 (setq done t))
314 (t
315 ;; We found an elif. Stop here.
316 (setq done t))))))
317
318(define-lex-regex-analyzer semantic-lex-c-if
319 "Code blocks wrapped up in #if, or #ifdef.
320Uses known macro tables in SPP to determine what block to skip."
321 "^\\s-*#\\s-*\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\s-*\\(\\(\\sw\\|\\s_\\)+\\)\\(\\s-*)\\)?\\s-*$"
322 (semantic-c-do-lex-if))
323
324(defun semantic-c-do-lex-if ()
325 "Handle lexical CPP if statements."
326 (let* ((sym (buffer-substring-no-properties
327 (match-beginning 3) (match-end 3)))
328 (defstr (buffer-substring-no-properties
329 (match-beginning 2) (match-end 2)))
330 (defined (string= defstr "defined("))
331 (notdefined (string= defstr "!defined("))
332 (ift (buffer-substring-no-properties
333 (match-beginning 1) (match-end 1)))
334 (ifdef (or (string= ift "ifdef")
335 (and (string= ift "if") defined)
336 (and (string= ift "elif") defined)
337 ))
338 (ifndef (or (string= ift "ifndef")
339 (and (string= ift "if") notdefined)
340 (and (string= ift "elif") notdefined)
341 ))
342 )
343 (if (or (and (or (string= ift "if") (string= ift "elif"))
344 (string= sym "0"))
345 (and ifdef (not (semantic-lex-spp-symbol-p sym)))
346 (and ifndef (semantic-lex-spp-symbol-p sym)))
347 ;; The if indecates to skip this preprocessor section
348 (let ((pt nil))
349 ;; (message "%s %s yes" ift sym)
350 (beginning-of-line)
351 (setq pt (point))
4feec2f5
CY
352 ;; This skips only a section of a conditional. Once that section
353 ;; is opened, encountering any new #else or related conditional
354 ;; should be skipped.
355 (semantic-c-skip-conditional-section)
356 (setq semantic-lex-end-point (point))
357 (semantic-push-parser-warning (format "Skip #%s %s" ift sym)
358 pt (point))
dd9af436
CY
359 ;; (semantic-lex-push-token
360 ;; (semantic-lex-token 'c-preprocessor-skip pt (point)))
4feec2f5
CY
361 nil)
362 ;; Else, don't ignore it, but do handle the internals.
363 ;;(message "%s %s no" ift sym)
364 (end-of-line)
365 (setq semantic-lex-end-point (point))
366 nil)))
367
368(define-lex-regex-analyzer semantic-lex-c-macro-else
369 "Ignore an #else block.
370We won't see the #else due to the macro skip section block
371unless we are actively parsing an open #if statement. In that
372case, we must skip it since it is the ELSE part."
373 "^\\s-*#\\s-*\\(else\\)"
374 (let ((pt (point)))
375 (semantic-c-skip-conditional-section)
376 (setq semantic-lex-end-point (point))
377 (semantic-push-parser-warning "Skip #else" pt (point))
378;; (semantic-lex-push-token
379;; (semantic-lex-token 'c-preprocessor-skip pt (point)))
380 nil))
381
382(define-lex-regex-analyzer semantic-lex-c-macrobits
383 "Ignore various forms of #if/#else/#endif conditionals."
384 "^\\s-*#\\s-*\\(if\\(n?def\\)?\\|endif\\|elif\\|else\\)"
385 (semantic-c-end-of-macro)
386 (setq semantic-lex-end-point (point))
387 nil)
388
389(define-lex-spp-include-analyzer semantic-lex-c-include-system
390 "Identify include strings, and return special tokens."
391 "^\\s-*#\\s-*include\\s-*<\\([^ \t\n>]+\\)>" 0
392 ;; Hit 1 is the name of the include.
393 (goto-char (match-end 0))
394 (setq semantic-lex-end-point (point))
395 (cons (buffer-substring-no-properties (match-beginning 1)
396 (match-end 1))
397 'system))
398
399(define-lex-spp-include-analyzer semantic-lex-c-include
400 "Identify include strings, and return special tokens."
401 "^\\s-*#\\s-*include\\s-*\"\\([^ \t\n>]+\\)\"" 0
402 ;; Hit 1 is the name of the include.
403 (goto-char (match-end 0))
404 (setq semantic-lex-end-point (point))
405 (cons (buffer-substring-no-properties (match-beginning 1)
406 (match-end 1))
407 nil))
408
409
410(define-lex-regex-analyzer semantic-lex-c-ignore-ending-backslash
411 "Skip backslash ending a line.
412Go to the next line."
413 "\\\\\\s-*\n"
414 (setq semantic-lex-end-point (match-end 0)))
415
416(define-lex-regex-analyzer semantic-lex-c-namespace-begin-macro
417 "Handle G++'s namespace macros which the pre-processor can't handle."
418 "\\(_GLIBCXX_BEGIN_NAMESPACE\\)(\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)\\s-*)"
419 (let* ((nsend (match-end 1))
420 (sym-start (match-beginning 2))
421 (sym-end (match-end 2))
422 (ms (buffer-substring-no-properties sym-start sym-end)))
423 ;; Push the namespace keyword.
424 (semantic-lex-push-token
425 (semantic-lex-token 'NAMESPACE (match-beginning 0) nsend "namespace"))
426 ;; Push the name.
427 (semantic-lex-push-token
428 (semantic-lex-token 'symbol sym-start sym-end ms))
429 )
430 (goto-char (match-end 0))
431 (let ((start (point))
432 (end 0))
433 ;; If we can't find a matching end, then create the fake list.
434 (when (re-search-forward "_GLIBCXX_END_NAMESPACE" nil t)
435 (setq end (point))
436 (semantic-lex-push-token
437 (semantic-lex-token 'semantic-list start end
438 (list 'prefix-fake)))))
439 (setq semantic-lex-end-point (point)))
440
441(defcustom semantic-lex-c-nested-namespace-ignore-second t
442 "Should _GLIBCXX_BEGIN_NESTED_NAMESPACE ignore the second namespace?
443It is really there, but if a majority of uses is to squeeze out
444the second namespace in use, then it should not be included.
445
446If you are having problems with smart completion and STL templates,
91abaf51 447it may be that this is set incorrectly. After changing the value
4feec2f5
CY
448of this flag, you will need to delete any semanticdb cache files
449that may have been incorrectly parsed."
450 :group 'semantic
451 :type 'boolean)
452
453(define-lex-regex-analyzer semantic-lex-c-VC++-begin-std-namespace
454 "Handle VC++'s definition of the std namespace."
455 "\\(_STD_BEGIN\\)"
456 (semantic-lex-push-token
457 (semantic-lex-token 'NAMESPACE (match-beginning 0) (match-end 0) "namespace"))
458 (semantic-lex-push-token
459 (semantic-lex-token 'symbol (match-beginning 0) (match-end 0) "std"))
460 (goto-char (match-end 0))
461 (let ((start (point))
462 (end 0))
463 (when (re-search-forward "_STD_END" nil t)
464 (setq end (point))
465 (semantic-lex-push-token
466 (semantic-lex-token 'semantic-list start end
467 (list 'prefix-fake)))))
468 (setq semantic-lex-end-point (point)))
469
470(define-lex-regex-analyzer semantic-lex-c-VC++-end-std-namespace
471 "Handle VC++'s definition of the std namespace."
472 "\\(_STD_END\\)"
473 (goto-char (match-end 0))
474 (setq semantic-lex-end-point (point)))
475
476(define-lex-regex-analyzer semantic-lex-c-namespace-begin-nested-macro
477 "Handle G++'s namespace macros which the pre-processor can't handle."
478 "\\(_GLIBCXX_BEGIN_NESTED_NAMESPACE\\)(\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)\\s-*,\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)\\s-*)"
479 (goto-char (match-end 0))
480 (let* ((nsend (match-end 1))
481 (sym-start (match-beginning 2))
482 (sym-end (match-end 2))
483 (ms (buffer-substring-no-properties sym-start sym-end))
484 (sym2-start (match-beginning 3))
485 (sym2-end (match-end 3))
486 (ms2 (buffer-substring-no-properties sym2-start sym2-end)))
487 ;; Push the namespace keyword.
488 (semantic-lex-push-token
489 (semantic-lex-token 'NAMESPACE (match-beginning 0) nsend "namespace"))
490 ;; Push the name.
491 (semantic-lex-push-token
492 (semantic-lex-token 'symbol sym-start sym-end ms))
493
494 (goto-char (match-end 0))
495 (let ((start (point))
496 (end 0))
497 ;; If we can't find a matching end, then create the fake list.
498 (when (re-search-forward "_GLIBCXX_END_NESTED_NAMESPACE" nil t)
499 (setq end (point))
500 (if semantic-lex-c-nested-namespace-ignore-second
501 ;; The same as _GLIBCXX_BEGIN_NAMESPACE
502 (semantic-lex-push-token
503 (semantic-lex-token 'semantic-list start end
504 (list 'prefix-fake)))
505 ;; Do both the top and second level namespace
506 (semantic-lex-push-token
507 (semantic-lex-token 'semantic-list start end
508 ;; We'll depend on a quick hack
509 (list 'prefix-fake-plus
510 (semantic-lex-token 'NAMESPACE
511 sym-end sym2-start
512 "namespace")
513 (semantic-lex-token 'symbol
514 sym2-start sym2-end
515 ms2)
516 (semantic-lex-token 'semantic-list start end
517 (list 'prefix-fake)))
518 )))
519 )))
520 (setq semantic-lex-end-point (point)))
521
522(define-lex-regex-analyzer semantic-lex-c-namespace-end-macro
523 "Handle G++'s namespace macros which the pre-processor can't handle."
524 "_GLIBCXX_END_\\(NESTED_\\)?NAMESPACE"
525 (goto-char (match-end 0))
526 (setq semantic-lex-end-point (point)))
527
528(define-lex-regex-analyzer semantic-lex-c-string
529 "Detect and create a C string token."
530 "L?\\(\\s\"\\)"
531 ;; Zing to the end of this string.
532 (semantic-lex-push-token
533 (semantic-lex-token
534 'string (point)
535 (save-excursion
536 ;; Skip L prefix if present.
537 (goto-char (match-beginning 1))
538 (semantic-lex-unterminated-syntax-protection 'string
539 (forward-sexp 1)
540 (point))
541 ))))
542
543(define-lex-regex-analyzer semantic-c-lex-ignore-newline
544 "Detect and ignore newline tokens.
545Use this ONLY if newlines are not whitespace characters (such as when
546they are comment end characters)."
547 ;; Just like semantic-lex-ignore-newline, but also ignores
548 ;; trailing \.
549 "\\s-*\\\\?\\s-*\\(\n\\|\\s>\\)"
550 (setq semantic-lex-end-point (match-end 0)))
551
552
553(define-lex semantic-c-lexer
554 "Lexical Analyzer for C code.
555Use semantic-cpp-lexer for parsing text inside a CPP macro."
556 ;; C preprocessor features
557 semantic-lex-cpp-define
558 semantic-lex-cpp-undef
559 semantic-lex-c-if
560 semantic-lex-c-macro-else
561 semantic-lex-c-macrobits
562 semantic-lex-c-include
563 semantic-lex-c-include-system
564 semantic-lex-c-ignore-ending-backslash
565 ;; Whitespace handling
566 semantic-lex-ignore-whitespace
567 semantic-c-lex-ignore-newline
568 ;; Non-preprocessor features
569 semantic-lex-number
570 ;; Must detect C strings before symbols because of possible L prefix!
571 semantic-lex-c-string
572 ;; Custom handlers for some macros come before the macro replacement analyzer.
573 semantic-lex-c-namespace-begin-macro
574 semantic-lex-c-namespace-begin-nested-macro
575 semantic-lex-c-namespace-end-macro
576 semantic-lex-c-VC++-begin-std-namespace
577 semantic-lex-c-VC++-end-std-namespace
578 ;; Handle macros, symbols, and keywords
579 semantic-lex-spp-replace-or-symbol-or-keyword
580 semantic-lex-charquote
581 semantic-lex-paren-or-list
582 semantic-lex-close-paren
583 semantic-lex-ignore-comments
584 semantic-lex-punctuation
585 semantic-lex-default-action)
586
587(define-lex-simple-regex-analyzer semantic-lex-cpp-hashhash
588 "Match ## inside a CPP macro as special."
589 "##" 'spp-concat)
590
591(define-lex semantic-cpp-lexer
592 "Lexical Analyzer for CPP macros in C code."
593 ;; CPP special
594 semantic-lex-cpp-hashhash
595 ;; C preprocessor features
596 semantic-lex-cpp-define
597 semantic-lex-cpp-undef
598 semantic-lex-c-if
599 semantic-lex-c-macro-else
600 semantic-lex-c-macrobits
601 semantic-lex-c-include
602 semantic-lex-c-include-system
603 semantic-lex-c-ignore-ending-backslash
604 ;; Whitespace handling
605 semantic-lex-ignore-whitespace
606 semantic-c-lex-ignore-newline
607 ;; Non-preprocessor features
608 semantic-lex-number
609 ;; Must detect C strings before symbols because of possible L prefix!
610 semantic-lex-c-string
611 ;; Parsing inside a macro means that we don't do macro replacement.
612 ;; semantic-lex-spp-replace-or-symbol-or-keyword
613 semantic-lex-symbol-or-keyword
614 semantic-lex-charquote
615 semantic-lex-paren-or-list
616 semantic-lex-close-paren
617 semantic-lex-ignore-comments
618 semantic-lex-punctuation
619 semantic-lex-default-action)
620
621(define-mode-local-override semantic-parse-region c-mode
622 (start end &optional nonterminal depth returnonerror)
91abaf51 623 "Calls `semantic-parse-region-default', except in a macro expansion.
4feec2f5
CY
624MACRO expansion mode is handled through the nature of Emacs's non-lexical
625binding of variables.
626START, END, NONTERMINAL, DEPTH, and RETURNONERRORS are the same
627as for the parent."
628 (if (and (boundp 'lse) (or (/= start 1) (/= end (point-max))))
629 (let* ((last-lexical-token lse)
630 (llt-class (semantic-lex-token-class last-lexical-token))
631 (llt-fakebits (car (cdr last-lexical-token)))
632 (macroexpand (stringp (car (cdr last-lexical-token)))))
633 (if macroexpand
634 (progn
635 ;; It is a macro expansion. Do something special.
636 ;;(message "MOOSE %S %S, %S : %S" start end nonterminal lse)
637 (semantic-c-parse-lexical-token
638 lse nonterminal depth returnonerror)
639 )
640 ;; Not a macro expansion, but perhaps a funny semantic-list
641 ;; is at the start? Remove the depth if our semantic list is not
642 ;; made of list tokens.
643 (if (and depth (= depth 1)
644 (eq llt-class 'semantic-list)
645 (not (null llt-fakebits))
646 (consp llt-fakebits)
647 (symbolp (car llt-fakebits))
648 )
649 (progn
650 (setq depth 0)
651
652 ;; This is a copy of semantic-parse-region-default where we
653 ;; are doing something special with the lexication of the
654 ;; contents of the semantic-list token. Stuff not used by C
655 ;; removed.
656 (let ((tokstream
657 (if (and (consp llt-fakebits)
658 (eq (car llt-fakebits) 'prefix-fake-plus))
659 ;; If our semantic-list is special, then only stick in the
660 ;; fake tokens.
661 (cdr llt-fakebits)
662 ;; Lex up the region with a depth of 0
663 (semantic-lex start end 0))))
664
665 ;; Do the parse
666 (nreverse
667 (semantic-repeat-parse-whole-stream tokstream
668 nonterminal
669 returnonerror))
670
671 ))
672
673 ;; It was not a macro expansion, nor a special semantic-list.
674 ;; Do old thing.
675 (semantic-parse-region-default start end
676 nonterminal depth
677 returnonerror)
678 )))
679 ;; Do the parse
680 (semantic-parse-region-default start end nonterminal
681 depth returnonerror)
682 ))
683
29e1a603 684(defvar semantic-c-parse-token-hack-depth 0
9bf6c65c 685 "Current depth of recursive calls to `semantic-c-parse-lexical-token'.")
29e1a603 686
4feec2f5
CY
687(defun semantic-c-parse-lexical-token (lexicaltoken nonterminal depth
688 returnonerror)
689 "Do a region parse on the contents of LEXICALTOKEN.
690Presumably, this token has a string in it from a macro.
691The text of the token is inserted into a different buffer, and
692parsed there.
693Argument NONTERMINAL, DEPTH, and RETURNONERROR are passed into
694the regular parser."
29e1a603
CY
695 (let* ((semantic-c-parse-token-hack-depth (1+ semantic-c-parse-token-hack-depth))
696 (buf (get-buffer-create (format " *C parse hack %d*"
697 semantic-c-parse-token-hack-depth)))
4feec2f5
CY
698 (mode major-mode)
699 (spp-syms semantic-lex-spp-dynamic-macro-symbol-obarray)
700 (stream nil)
701 (start (semantic-lex-token-start lexicaltoken))
702 (end (semantic-lex-token-end lexicaltoken))
703 (symtext (semantic-lex-token-text lexicaltoken))
704 (macros (get-text-property 0 'macros symtext))
705 )
dd9af436
CY
706 (if (> semantic-c-parse-token-hack-depth 5)
707 nil
708 (with-current-buffer buf
709 (erase-buffer)
710 (when (not (eq major-mode mode))
711 (save-match-data
712
713 ;; Protect against user hooks throwing errors.
714 (condition-case nil
715 (funcall mode)
716 (error
717 (if (y-or-n-p
718 (format "There was an error initializing %s in buffer \"%s\". Debug your hooks? "
719 mode (buffer-name)))
720 (semantic-c-debug-mode-init mode)
721 (message "Macro parsing state may be broken...")
722 (sit-for 1))))
723 ) ; save match data
724
725 ;; Hack in mode-local
726 (activate-mode-local-bindings)
727 ;; CHEATER! The following 3 lines are from
728 ;; `semantic-new-buffer-fcn', but we don't want to turn
729 ;; on all the other annoying modes for this little task.
730 (setq semantic-new-buffer-fcn-was-run t)
731 (semantic-lex-init)
732 (semantic-clear-toplevel-cache)
733 (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
734 t)
735 )
736 ;; Get the macro symbol table right.
737 (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
738 ;; (message "%S" macros)
739 (dolist (sym macros)
740 (semantic-lex-spp-symbol-set (car sym) (cdr sym)))
741
742 (insert symtext)
743
744 (setq stream
745 (semantic-parse-region-default
746 (point-min) (point-max) nonterminal depth returnonerror))
747
748 ;; Clean up macro symbols
749 (dolist (sym macros)
750 (semantic-lex-spp-symbol-remove (car sym)))
751
752 ;; Convert the text of the stream.
753 (dolist (tag stream)
754 ;; Only do two levels here 'cause I'm lazy.
755 (semantic--tag-set-overlay tag (list start end))
756 (dolist (stag (semantic-tag-components-with-overlays tag))
757 (semantic--tag-set-overlay stag (list start end))
758 ))
759 ))
4feec2f5
CY
760 stream))
761
8d106ea0
CY
762(defvar semantic-c-debug-mode-init-last-mode nil
763 "The most recent mode needing debugging.")
764
765(defun semantic-c-debug-mode-init (mm)
766 "Debug mode init for major mode MM after we're done parsing now."
767 (interactive (list semantic-c-debug-mode-init-last-mode))
2054a44c 768 (if (called-interactively-p 'interactive)
8d106ea0
CY
769 ;; Do the debug.
770 (progn
771 (switch-to-buffer (get-buffer-create "*MODE HACK TEST*"))
772 (let ((debug-on-error t))
773 (funcall mm)))
774
775 ;; Notify about the debug
776 (setq semantic-c-debug-mode-init-last-mode mm)
777
778 (add-hook 'post-command-hook 'semantic-c-debug-mode-init-pch)))
779
780(defun semantic-c-debug-mode-init-pch ()
781 "Notify user about needing to debug their major mode hooks."
782 (let ((mm semantic-c-debug-mode-init-last-mode))
783 (switch-to-buffer-other-window
784 (get-buffer-create "*MODE HACK TEST*"))
785 (erase-buffer)
91abaf51 786 (insert "A failure occurred while parsing your buffers.
8d106ea0 787
91abaf51 788The failure occurred while attempting to initialize " (symbol-name mm) " in a
8d106ea0
CY
789buffer not associated with a file. To debug this problem, type
790
791M-x semantic-c-debug-mode-init
792
793now.
794")
795 (remove-hook 'post-command-hook 'semantic-c-debug-mode-init-pch)))
796
4feec2f5
CY
797(defun semantic-expand-c-tag (tag)
798 "Expand TAG into a list of equivalent tags, or nil."
799 (let ((return-list nil)
800 )
801 ;; Expand an EXTERN C first.
802 (when (eq (semantic-tag-class tag) 'extern)
803 (let* ((mb (semantic-tag-get-attribute tag :members))
804 (ret mb))
805 (while mb
806 (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers)))
807 (setq mods (cons "extern" (cons "\"C\"" mods)))
808 (semantic-tag-put-attribute (car mb) :typemodifiers mods))
809 (setq mb (cdr mb)))
810 (setq return-list ret)))
811
812 ;; Function or variables that have a :type that is some complex
813 ;; thing, extract it, and replace it with a reference.
814 ;;
815 ;; Thus, struct A { int a; } B;
816 ;;
817 ;; will create 2 toplevel tags, one is type A, and the other variable B
818 ;; where the :type of B is just a type tag A that is a prototype, and
819 ;; the actual struct info of A is it's own toplevel tag.
820 (when (or (semantic-tag-of-class-p tag 'function)
821 (semantic-tag-of-class-p tag 'variable))
822 (let* ((basetype (semantic-tag-type tag))
823 (typeref nil)
824 (tname (when (consp basetype)
825 (semantic-tag-name basetype))))
826 ;; Make tname be a string.
827 (when (consp tname) (setq tname (car (car tname))))
828 ;; Is the basetype a full type with a name of its own?
829 (when (and basetype (semantic-tag-p basetype)
830 (not (semantic-tag-prototype-p basetype))
831 tname
832 (not (string= tname "")))
833 ;; a type tag referencing the type we are extracting.
834 (setq typeref (semantic-tag-new-type
835 (semantic-tag-name basetype)
836 (semantic-tag-type basetype)
837 nil nil
838 :prototype t))
839 ;; Convert original tag to only have a reference.
840 (setq tag (semantic-tag-copy tag))
841 (semantic-tag-put-attribute tag :type typeref)
842 ;; Convert basetype to have the location information.
843 (semantic--tag-copy-properties tag basetype)
844 (semantic--tag-set-overlay basetype
845 (semantic-tag-overlay tag))
846 ;; Store the base tag as part of the return list.
847 (setq return-list (cons basetype return-list)))))
848
849 ;; Name of the tag is a list, so expand it. Tag lists occur
850 ;; for variables like this: int var1, var2, var3;
851 ;;
852 ;; This will expand that to 3 tags that happen to share the
853 ;; same overlay information.
854 (if (consp (semantic-tag-name tag))
855 (let ((rl (semantic-expand-c-tag-namelist tag)))
856 (cond
857 ;; If this returns nothing, then return nil overall
858 ;; because that will restore the old TAG input.
859 ((not rl) (setq return-list nil))
860 ;; If we have a return, append it to the existing list
861 ;; of returns.
862 ((consp rl)
863 (setq return-list (append rl return-list)))
864 ))
865 ;; If we didn't have a list, but the return-list is non-empty,
866 ;; that means we still need to take our existing tag, and glom
867 ;; it onto our extracted type.
868 (if (consp return-list)
869 (setq return-list (cons tag return-list)))
870 )
871
872 ;; Default, don't change the tag means returning nil.
873 return-list))
874
875(defun semantic-expand-c-tag-namelist (tag)
876 "Expand TAG whose name is a list into a list of tags, or nil."
877 (cond ((semantic-tag-of-class-p tag 'variable)
878 ;; The name part comes back in the form of:
879 ;; ( NAME NUMSTARS BITS ARRAY ASSIGN )
880 (let ((vl nil)
881 (basety (semantic-tag-type tag))
882 (ty "")
883 (mods (semantic-tag-get-attribute tag :typemodifiers))
884 (suffix "")
885 (lst (semantic-tag-name tag))
886 (default nil)
887 (cur nil))
888 ;; Open up each name in the name list.
889 (while lst
890 (setq suffix "" ty "")
891 (setq cur (car lst))
892 (if (nth 2 cur)
893 (setq suffix (concat ":" (nth 2 cur))))
894 (if (= (length basety) 1)
895 (setq ty (car basety))
896 (setq ty basety))
897 (setq default (nth 4 cur))
898 (setq vl (cons
899 (semantic-tag-new-variable
900 (car cur) ;name
901 ty ;type
902 (if default
903 (buffer-substring-no-properties
904 (car default) (car (cdr default))))
905 :constant-flag (semantic-tag-variable-constant-p tag)
906 :suffix suffix
907 :typemodifiers mods
908 :dereference (length (nth 3 cur))
909 :pointer (nth 1 cur)
910 :reference (semantic-tag-get-attribute tag :reference)
911 :documentation (semantic-tag-docstring tag) ;doc
912 )
913 vl))
914 (semantic--tag-copy-properties tag (car vl))
915 (semantic--tag-set-overlay (car vl)
916 (semantic-tag-overlay tag))
917 (setq lst (cdr lst)))
918 ;; Return the list
919 (nreverse vl)))
920 ((semantic-tag-of-class-p tag 'type)
921 ;; We may someday want to add an extra check for a type
922 ;; of type "typedef".
923 ;; Each elt of NAME is ( STARS NAME )
924 (let ((vl nil)
dd9af436
CY
925 (names (semantic-tag-name tag))
926 (super (semantic-tag-get-attribute tag :superclasses))
927 (addlast nil))
928
929 (when (and (semantic-tag-of-type-p tag "typedef")
930 (semantic-tag-of-class-p super 'type)
931 (semantic-tag-type-members super))
932 ;; This is a typedef of a real type. Extract
933 ;; the super class, and stick it into the tags list.
934 (setq addlast super)
935
936 ;; Clone super and remove the members IFF super has a name.
937 ;; Note: anonymous struct/enums that are typedef'd shouldn't
938 ;; exist in the top level type list, so they will appear only
939 ;; in the :typedef slot of the typedef.
940 (setq super (semantic-tag-clone super))
941 (if (not (string= (semantic-tag-name super) ""))
942 (semantic-tag-put-attribute super :members nil)
943 (setq addlast nil))
944
945 ;; Add in props to the full superclass.
946 (when addlast
947 (semantic--tag-copy-properties tag addlast)
948 (semantic--tag-set-overlay addlast (semantic-tag-overlay tag)))
949 )
950
4feec2f5 951 (while names
dd9af436 952
4feec2f5
CY
953 (setq vl (cons (semantic-tag-new-type
954 (nth 1 (car names)) ; name
955 "typedef"
956 (semantic-tag-type-members tag)
957 ;; parent is just tbe name of what
958 ;; is passed down as a tag.
959 (list
960 (semantic-tag-name
961 (semantic-tag-type-superclasses tag)))
962 :pointer
963 (let ((stars (car (car (car names)))))
964 (if (= stars 0) nil stars))
965 ;; This specifies what the typedef
966 ;; is expanded out as. Just the
967 ;; name shows up as a parent of this
968 ;; typedef.
dd9af436 969 :typedef super
4feec2f5
CY
970 ;;(semantic-tag-type-superclasses tag)
971 :documentation
972 (semantic-tag-docstring tag))
973 vl))
974 (semantic--tag-copy-properties tag (car vl))
dd9af436 975 (semantic--tag-set-overlay (car vl) (semantic-tag-overlay tag))
4feec2f5 976 (setq names (cdr names)))
dd9af436
CY
977
978 ;; Add typedef superclass last.
979 (when addlast (setq vl (cons addlast vl)))
980
4feec2f5
CY
981 vl))
982 ((and (listp (car tag))
983 (semantic-tag-of-class-p (car tag) 'variable))
984 ;; Argument lists come in this way. Append all the expansions!
985 (let ((vl nil))
986 (while tag
987 (setq vl (append (semantic-tag-components (car vl))
988 vl)
989 tag (cdr tag)))
990 vl))
991 (t nil)))
992
993(defvar-mode-local c-mode semantic-tag-expand-function 'semantic-expand-c-tag
994 "Function used to expand tags generated in the C bovine parser.")
995
996(defvar semantic-c-classname nil
997 "At parse time, assign a class or struct name text here.
998It is picked up by `semantic-c-reconstitute-token' to determine
999if something is a constructor. Value should be:
91abaf51 1000 (TYPENAME . TYPEOFTYPE)
4feec2f5
CY
1001where typename is the name of the type, and typeoftype is \"class\"
1002or \"struct\".")
1003
ca7c89d8
GM
1004(define-mode-local-override semantic-analyze-split-name c-mode (name)
1005 "Split up tag names on colon (:) boundaries."
1006 (let ((ans (split-string name ":")))
1007 (if (= (length ans) 1)
1008 name
1009 (delete "" ans))))
1010
4feec2f5
CY
1011(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
1012 "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
1013This is so we don't have to match the same starting text several times.
1014Optional argument STAR and REF indicate the number of * and & in the typedef."
1015 (when (and (listp typedecl)
1016 (= 1 (length typedecl))
1017 (stringp (car typedecl)))
1018 (setq typedecl (car typedecl)))
1019 (cond ((eq (nth 1 tokenpart) 'variable)
1020 (semantic-tag-new-variable
1021 (car tokenpart)
1022 (or typedecl "int") ;type
1023 nil ;default value (filled with expand)
1024 :constant-flag (if (member "const" declmods) t nil)
1025 :typemodifiers (delete "const" declmods)
1026 )
1027 )
1028 ((eq (nth 1 tokenpart) 'function)
1029 ;; We should look at part 4 (the arglist) here, and throw an
1030 ;; error of some sort if it contains parser errors so that we
1031 ;; don't parser function calls, but that is a little beyond what
1032 ;; is available for data here.
1033 (let* ((constructor
1034 (and (or (and semantic-c-classname
1035 (string= (car semantic-c-classname)
1036 (car tokenpart)))
1037 (and (stringp (car (nth 2 tokenpart)))
1038 (string= (car (nth 2 tokenpart)) (car tokenpart)))
dd9af436 1039 (nth 10 tokenpart) ; initializers
4feec2f5
CY
1040 )
1041 (not (car (nth 3 tokenpart)))))
1042 (fcnpointer (string-match "^\\*" (car tokenpart)))
1043 (fnname (if fcnpointer
1044 (substring (car tokenpart) 1)
1045 (car tokenpart)))
1046 (operator (if (string-match "[a-zA-Z]" fnname)
1047 nil
1048 t))
1049 )
1050 (if fcnpointer
1051 ;; Function pointers are really variables.
1052 (semantic-tag-new-variable
1053 fnname
1054 typedecl
1055 nil
1056 ;; It is a function pointer
1057 :functionpointer-flag t
1058 )
1059 ;; The function
1060 (semantic-tag-new-function
1061 fnname
1062 (or typedecl ;type
1063 (cond ((car (nth 3 tokenpart) )
1064 "void") ; Destructors have no return?
1065 (constructor
1066 ;; Constructors return an object.
1067 (semantic-tag-new-type
1068 ;; name
1069 (or (car semantic-c-classname)
dd9af436
CY
1070 (let ((split (semantic-analyze-split-name-c-mode
1071 (car (nth 2 tokenpart)))))
1072 (if (stringp split) split
1073 (car (last split)))))
4feec2f5
CY
1074 ;; type
1075 (or (cdr semantic-c-classname)
1076 "class")
1077 ;; members
1078 nil
1079 ;; parents
1080 nil
1081 ))
1082 (t "int")))
1083 (nth 4 tokenpart) ;arglist
1084 :constant-flag (if (member "const" declmods) t nil)
1085 :typemodifiers (delete "const" declmods)
1086 :parent (car (nth 2 tokenpart))
1087 :destructor-flag (if (car (nth 3 tokenpart) ) t)
1088 :constructor-flag (if constructor t)
1089 :pointer (nth 7 tokenpart)
1090 :operator-flag operator
1091 ;; Even though it is "throw" in C++, we use
1092 ;; `throws' as a common name for things that toss
1093 ;; exceptions about.
1094 :throws (nth 5 tokenpart)
09e80d9f 1095 ;; Reentrant is a C++ thingy. Add it here
4feec2f5
CY
1096 :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
1097 ;; A function post-const is funky. Try stuff
1098 :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
1099 ;; prototypes are functions w/ no body
1100 :prototype-flag (if (nth 8 tokenpart) t)
1101 ;; Pure virtual
1102 :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
1103 ;; Template specifier.
1104 :template-specifier (nth 9 tokenpart)
1105 )))
1106 )
1107 ))
1108
1109(defun semantic-c-reconstitute-template (tag specifier)
1110 "Reconstitute the token TAG with the template SPECIFIER."
1111 (semantic-tag-put-attribute tag :template (or specifier ""))
1112 tag)
1113
1114\f
1115;;; Override methods & Variables
1116;;
1117(define-mode-local-override semantic-format-tag-name
1118 c-mode (tag &optional parent color)
1119 "Convert TAG to a string that is the print name for TAG.
1120Optional PARENT and COLOR are ignored."
1121 (let ((name (semantic-format-tag-name-default tag parent color))
1122 (fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
1123 )
1124 (if (not fnptr)
1125 name
1126 (concat "(*" name ")"))
1127 ))
1128
1129(define-mode-local-override semantic-format-tag-canonical-name
1130 c-mode (tag &optional parent color)
1131 "Create a cannonical name for TAG.
1132PARENT specifies a parent class.
1133COLOR indicates that the text should be type colorized.
1134Enhances the base class to search for the entire parent
1135tree to make the name accurate."
1136 (semantic-format-tag-canonical-name-default tag parent color)
1137 )
1138
1139(define-mode-local-override semantic-format-tag-type c-mode (tag color)
1140 "Convert the data type of TAG to a string usable in tag formatting.
1141Adds pointer and reference symbols to the default.
1142Argument COLOR adds color to the text."
1143 (let* ((type (semantic-tag-type tag))
1144 (defaulttype nil)
1145 (point (semantic-tag-get-attribute tag :pointer))
1146 (ref (semantic-tag-get-attribute tag :reference))
1147 )
1148 (if (semantic-tag-p type)
1149 (let ((typetype (semantic-tag-type type))
1150 (typename (semantic-tag-name type)))
1151 ;; Create the string that expresses the type
1152 (if (string= typetype "class")
1153 (setq defaulttype typename)
1154 (setq defaulttype (concat typetype " " typename))))
1155 (setq defaulttype (semantic-format-tag-type-default tag color)))
1156
1157 ;; Colorize
1158 (when color
1159 (setq defaulttype (semantic--format-colorize-text defaulttype 'type)))
1160
1161 ;; Add refs, ptrs, etc
1162 (if ref (setq ref "&"))
1163 (if point (setq point (make-string point ?*)) "")
1164 (when type
1165 (concat defaulttype ref point))
1166 ))
1167
1168(define-mode-local-override semantic-find-tags-by-scope-protection
1169 c-mode (scopeprotection parent &optional table)
1170 "Override the usual search for protection.
1171We can be more effective than the default by scanning through once,
1172and collecting tags based on the labels we see along the way."
1173 (if (not table) (setq table (semantic-tag-type-members parent)))
1174 (if (null scopeprotection)
1175 table
1176 (let ((ans nil)
1177 (curprot 1)
1178 (targetprot (cond ((eq scopeprotection 'public)
1179 1)
1180 ((eq scopeprotection 'protected)
1181 2)
1182 (t 3)
1183 ))
1184 (alist '(("public" . 1)
1185 ("protected" . 2)
1186 ("private" . 3)))
1187 )
1188 (dolist (tag table)
1189 (cond
1190 ((semantic-tag-of-class-p tag 'label)
1191 (setq curprot (cdr (assoc (semantic-tag-name tag) alist)))
1192 )
1193 ((>= targetprot curprot)
1194 (setq ans (cons tag ans)))
1195 ))
1196 ans)))
1197
1198(define-mode-local-override semantic-tag-protection
1199 c-mode (tag &optional parent)
1200 "Return the protection of TAG in PARENT.
1201Override function for `semantic-tag-protection'."
1202 (let ((mods (semantic-tag-modifiers tag))
1203 (prot nil))
1204 ;; Check the modifiers for protection if we are not a child
1205 ;; of some class type.
1206 (when (or (not parent) (not (eq (semantic-tag-class parent) 'type)))
1207 (while (and (not prot) mods)
1208 (if (stringp (car mods))
1209 (let ((s (car mods)))
1210 ;; A few silly defaults to get things started.
1211 (cond ((or (string= s "extern")
1212 (string= s "export"))
1213 'public)
1214 ((string= s "static")
1215 'private))))
1216 (setq mods (cdr mods))))
1217 ;; If we have a typed parent, look for :public style labels.
1218 (when (and parent (eq (semantic-tag-class parent) 'type))
1219 (let ((pp (semantic-tag-type-members parent)))
1220 (while (and pp (not (semantic-equivalent-tag-p (car pp) tag)))
1221 (when (eq (semantic-tag-class (car pp)) 'label)
1222 (setq prot
1223 (cond ((string= (semantic-tag-name (car pp)) "public")
1224 'public)
1225 ((string= (semantic-tag-name (car pp)) "private")
1226 'private)
1227 ((string= (semantic-tag-name (car pp)) "protected")
1228 'protected)))
1229 )
1230 (setq pp (cdr pp)))))
1231 (when (and (not prot) (eq (semantic-tag-class parent) 'type))
1232 (setq prot
1233 (cond ((string= (semantic-tag-type parent) "class") 'private)
1234 ((string= (semantic-tag-type parent) "struct") 'public)
1235 (t 'unknown))))
1236 (or prot
1237 (if (and parent (semantic-tag-of-class-p parent 'type))
1238 'public
1239 nil))))
1240
1241(define-mode-local-override semantic-tag-components c-mode (tag)
1242 "Return components for TAG."
1243 (if (and (eq (semantic-tag-class tag) 'type)
1244 (string= (semantic-tag-type tag) "typedef"))
1245 ;; A typedef can contain a parent who has positional children,
1246 ;; but that parent will not have a position. Do this funny hack
1247 ;; to make sure we can apply overlays properly.
1248 (let ((sc (semantic-tag-get-attribute tag :typedef)))
1249 (when (semantic-tag-p sc) (semantic-tag-components sc)))
1250 (semantic-tag-components-default tag)))
1251
1252(defun semantic-c-tag-template (tag)
1253 "Return the template specification for TAG, or nil."
1254 (semantic-tag-get-attribute tag :template))
1255
1256(defun semantic-c-tag-template-specifier (tag)
1257 "Return the template specifier specification for TAG, or nil."
1258 (semantic-tag-get-attribute tag :template-specifier))
1259
1260(defun semantic-c-template-string-body (templatespec)
1261 "Convert TEMPLATESPEC into a string.
1262This might be a string, or a list of tokens."
1263 (cond ((stringp templatespec)
1264 templatespec)
1265 ((semantic-tag-p templatespec)
1266 (semantic-format-tag-abbreviate templatespec))
1267 ((listp templatespec)
1268 (mapconcat 'semantic-format-tag-abbreviate templatespec ", "))))
1269
1270(defun semantic-c-template-string (token &optional parent color)
1271 "Return a string representing the TEMPLATE attribute of TOKEN.
1272This string is prefixed with a space, or is the empty string.
1273Argument PARENT specifies a parent type.
1274Argument COLOR specifies that the string should be colorized."
1275 (let ((t2 (semantic-c-tag-template-specifier token))
1276 (t1 (semantic-c-tag-template token))
1277 ;; @todo - Need to account for a parent that is a template
1278 (pt1 (if parent (semantic-c-tag-template parent)))
1279 (pt2 (if parent (semantic-c-tag-template-specifier parent)))
1280 )
1281 (cond (t2 ;; we have a template with specifier
1282 (concat " <"
1283 ;; Fill in the parts here
1284 (semantic-c-template-string-body t2)
1285 ">"))
1286 (t1 ;; we have a template without specifier
1287 " <>")
1288 (t
1289 ""))))
1290
1291(define-mode-local-override semantic-format-tag-concise-prototype
1292 c-mode (token &optional parent color)
1293 "Return an abbreviated string describing TOKEN for C and C++.
1294Optional PARENT and COLOR as specified with
1295`semantic-format-tag-abbreviate-default'."
1296 ;; If we have special template things, append.
1297 (concat (semantic-format-tag-concise-prototype-default token parent color)
1298 (semantic-c-template-string token parent color)))
1299
1300(define-mode-local-override semantic-format-tag-uml-prototype
1301 c-mode (token &optional parent color)
91abaf51 1302 "Return an UML string describing TOKEN for C and C++.
4feec2f5
CY
1303Optional PARENT and COLOR as specified with
1304`semantic-abbreviate-tag-default'."
1305 ;; If we have special template things, append.
1306 (concat (semantic-format-tag-uml-prototype-default token parent color)
1307 (semantic-c-template-string token parent color)))
1308
1309(define-mode-local-override semantic-tag-abstract-p
1310 c-mode (tag &optional parent)
1311 "Return non-nil if TAG is considered abstract.
1312PARENT is tag's parent.
1313In C, a method is abstract if it is `virtual', which is already
1314handled. A class is abstract iff it's destructor is virtual."
1315 (cond
1316 ((eq (semantic-tag-class tag) 'type)
1317 (require 'semantic/find)
1318 (or (semantic-brute-find-tag-by-attribute :pure-virtual-flag
1319 (semantic-tag-components tag)
1320 )
1321 (let* ((ds (semantic-brute-find-tag-by-attribute
1322 :destructor-flag
1323 (semantic-tag-components tag)
1324 ))
1325 (cs (semantic-brute-find-tag-by-attribute
1326 :constructor-flag
1327 (semantic-tag-components tag)
1328 )))
1329 (and ds (member "virtual" (semantic-tag-modifiers (car ds)))
1330 cs (eq 'protected (semantic-tag-protection (car cs) tag))
1331 )
1332 )))
1333 ((eq (semantic-tag-class tag) 'function)
1334 (or (semantic-tag-get-attribute tag :pure-virtual-flag)
1335 (member "virtual" (semantic-tag-modifiers tag))))
1336 (t (semantic-tag-abstract-p-default tag parent))))
1337
1338(defun semantic-c-dereference-typedef (type scope &optional type-declaration)
1339 "If TYPE is a typedef, get TYPE's type by name or tag, and return.
1340SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef."
1341 (if (and (eq (semantic-tag-class type) 'type)
1342 (string= (semantic-tag-type type) "typedef"))
1343 (let ((dt (semantic-tag-get-attribute type :typedef)))
1344 (cond ((and (semantic-tag-p dt)
1345 (not (semantic-analyze-tag-prototype-p dt)))
1346 ;; In this case, DT was declared directly. We need
1347 ;; to clone DT and apply a filename to it.
1348 (let* ((fname (semantic-tag-file-name type))
1349 (def (semantic-tag-copy dt nil fname)))
1350 (list def def)))
1351 ((stringp dt) (list dt (semantic-tag dt 'type)))
1352 ((consp dt) (list (car dt) dt))))
1353
1354 (list type type-declaration)))
1355
1356(defun semantic-c--instantiate-template (tag def-list spec-list)
1357 "Replace TAG name according to template specification.
1358DEF-LIST is the template information.
1359SPEC-LIST is the template specifier of the datatype instantiated."
1360 (when (and (car def-list) (car spec-list))
1361
1362 (when (and (string= (semantic-tag-type (car def-list)) "class")
1363 (string= (semantic-tag-name tag) (semantic-tag-name (car def-list))))
1364 (semantic-tag-set-name tag (semantic-tag-name (car spec-list))))
1365
1366 (semantic-c--instantiate-template tag (cdr def-list) (cdr spec-list))))
1367
1368(defun semantic-c--template-name-1 (spec-list)
9bf6c65c
GM
1369 "Return a string used to compute template class name.
1370Based on SPEC-LIST, for ref<Foo,Bar> it will return 'Foo,Bar'."
4feec2f5
CY
1371 (when (car spec-list)
1372 (let* ((endpart (semantic-c--template-name-1 (cdr spec-list)))
1373 (separator (and endpart ",")))
1374 (concat (semantic-tag-name (car spec-list)) separator endpart))))
1375
1376(defun semantic-c--template-name (type spec-list)
1377 "Return a template class name for TYPE based on SPEC-LIST.
1378For a type `ref' with a template specifier of (Foo Bar) it will
1379return 'ref<Foo,Bar>'."
1380 (concat (semantic-tag-name type)
1381 "<" (semantic-c--template-name-1 (cdr spec-list)) ">"))
1382
1383(defun semantic-c-dereference-template (type scope &optional type-declaration)
9bf6c65c 1384 "Dereference any template specifiers in TYPE within SCOPE.
4feec2f5
CY
1385If TYPE is a template, return a TYPE copy with the templates types
1386instantiated as specified in TYPE-DECLARATION."
1387 (when (semantic-tag-p type-declaration)
1388 (let ((def-list (semantic-tag-get-attribute type :template))
1389 (spec-list (semantic-tag-get-attribute type-declaration :template-specifier)))
1390 (when (and def-list spec-list)
1391 (setq type (semantic-tag-deep-copy-one-tag
1392 type
1393 (lambda (tag)
1394 (when (semantic-tag-of-class-p tag 'type)
1395 (semantic-c--instantiate-template
1396 tag def-list spec-list))
1397 tag)
1398 ))
1399 (semantic-tag-set-name type (semantic-c--template-name type spec-list))
1400 (semantic-tag-put-attribute type :template nil)
1401 (semantic-tag-set-faux type))))
1402 (list type type-declaration))
1403
1404;;; Patch here by "Raf" for instantiating templates.
1405(defun semantic-c-dereference-member-of (type scope &optional type-declaration)
1406 "Dereference through the `->' operator of TYPE.
1407Uses the return type of the '->' operator if it is contained in TYPE.
1408SCOPE is the current local scope to perform searches in.
1409TYPE-DECLARATION is passed through."
1410 (if semantic-c-member-of-autocast
1411 (let ((operator (car (semantic-find-tags-by-name "->" (semantic-analyze-scoped-type-parts type)))))
1412 (if operator
1413 (list (semantic-tag-get-attribute operator :type) (semantic-tag-get-attribute operator :type))
1414 (list type type-declaration)))
1415 (list type type-declaration)))
1416
1417;; David Engster: The following three functions deal with namespace
1418;; aliases and types which are member of a namespace through a using
1419;; statement. For examples, see the file semantic/tests/testusing.cpp,
1420;; tests 5 and following.
1421
1422(defun semantic-c-dereference-namespace (type scope &optional type-declaration)
1423 "Dereference namespace which might hold an 'alias' for TYPE.
1424Such an alias can be created through 'using' statements in a
91abaf51 1425namespace declaration. This function checks the namespaces in
4feec2f5
CY
1426SCOPE for such statements."
1427 (let ((scopetypes (oref scope scopetypes))
1428 typename currentns tmp usingname result namespaces)
1429 (when (and (semantic-tag-p type-declaration)
1430 (or (null type) (semantic-tag-prototype-p type)))
1431 (setq typename (semantic-analyze-split-name (semantic-tag-name type-declaration)))
1432 ;; If we already have that TYPE in SCOPE, we do nothing
1433 (unless (semantic-deep-find-tags-by-name (or (car-safe typename) typename) scopetypes)
1434 (if (stringp typename)
1435 ;; The type isn't fully qualified, so we have to search in all namespaces in SCOPE.
1436 (setq namespaces (semantic-find-tags-by-type "namespace" scopetypes))
1437 ;; This is a fully qualified name, so we only have to search one namespace.
1438 (setq namespaces (semanticdb-typecache-find (car typename)))
1439 ;; Make sure it's really a namespace.
1440 (if (string= (semantic-tag-type namespaces) "namespace")
1441 (setq namespaces (list namespaces))
1442 (setq namespaces nil)))
1443 (setq result nil)
1444 ;; Iterate over all the namespaces we have to check.
1445 (while (and namespaces
1446 (null result))
1447 (setq currentns (car namespaces))
1448 ;; Check if this is namespace is an alias and dereference it if necessary.
1449 (setq result (semantic-c-dereference-namespace-alias type-declaration currentns))
1450 (unless result
1451 ;; Otherwise, check if we can reach the type through 'using' statements.
1452 (setq result
1453 (semantic-c-check-type-namespace-using type-declaration currentns)))
1454 (setq namespaces (cdr namespaces)))))
1455 (if result
1456 ;; we have found the original type
1457 (list result result)
1458 (list type type-declaration))))
1459
1460(defun semantic-c-dereference-namespace-alias (type namespace)
1461 "Dereference TYPE in NAMESPACE, given that NAMESPACE is an alias.
1462Checks if NAMESPACE is an alias and if so, returns a new type
1463with a fully qualified name in the original namespace. Returns
1464nil if NAMESPACE is not an alias."
1465 (when (eq (semantic-tag-get-attribute namespace :kind) 'alias)
1466 (let ((typename (semantic-analyze-split-name (semantic-tag-name type)))
a964f5e5
CY
1467 ns nstype originaltype newtype)
1468 ;; Make typename unqualified
1469 (if (listp typename)
1470 (setq typename (last typename))
1471 (setq typename (list typename)))
4feec2f5 1472 (when
a964f5e5
CY
1473 (and
1474 ;; Get original namespace and make sure TYPE exists there.
1475 (setq ns (semantic-tag-name
1476 (car (semantic-tag-get-attribute namespace :members))))
1477 (setq nstype (semanticdb-typecache-find ns))
1478 (setq originaltype (semantic-find-tags-by-name
1479 (car typename)
1480 (semantic-tag-get-attribute nstype :members))))
4feec2f5 1481 ;; Construct new type with name in original namespace.
a964f5e5 1482 (setq ns (semantic-analyze-split-name ns))
4feec2f5
CY
1483 (setq newtype
1484 (semantic-tag-clone
a964f5e5 1485 (car originaltype)
4feec2f5
CY
1486 (semantic-analyze-unsplit-name
1487 (if (listp ns)
a964f5e5
CY
1488 (append ns typename)
1489 (append (list ns) typename)))))))))
4feec2f5
CY
1490
1491;; This searches a type in a namespace, following through all using
1492;; statements.
1493(defun semantic-c-check-type-namespace-using (type namespace)
1494 "Check if TYPE is accessible in NAMESPACE through a using statement.
1495Returns the original type from the namespace where it is defined,
1496or nil if it cannot be found."
1497 (let (usings result usingname usingtype unqualifiedname members shortname tmp)
1498 ;; Get all using statements from NAMESPACE.
1499 (when (and (setq usings (semantic-tag-get-attribute namespace :members))
1500 (setq usings (semantic-find-tags-by-class 'using usings)))
1501 ;; Get unqualified typename.
1502 (when (listp (setq unqualifiedname (semantic-analyze-split-name
1503 (semantic-tag-name type))))
1504 (setq unqualifiedname (car (last unqualifiedname))))
1505 ;; Iterate over all using statements in NAMESPACE.
1506 (while (and usings
1507 (null result))
1508 (setq usingname (semantic-analyze-split-name
1509 (semantic-tag-name (car usings)))
1510 usingtype (semantic-tag-type (semantic-tag-type (car usings))))
1511 (cond
1512 ((or (string= usingtype "namespace")
1513 (stringp usingname))
1514 ;; We are dealing with a 'using [namespace] NAMESPACE;'
1515 ;; Search for TYPE in that namespace
1516 (setq result
1517 (semanticdb-typecache-find usingname))
1518 (if (and result
1519 (setq members (semantic-tag-get-attribute result :members))
1520 (setq members (semantic-find-tags-by-name unqualifiedname members)))
1521 ;; TYPE is member of that namespace, so we are finished
1522 (setq result (car members))
1523 ;; otherwise recursively search in that namespace for an alias
1524 (setq result (semantic-c-check-type-namespace-using type result))
1525 (when result
1526 (setq result (semantic-tag-type result)))))
1527 ((and (string= usingtype "class")
1528 (listp usingname))
1529 ;; We are dealing with a 'using TYPE;'
1530 (when (string= unqualifiedname (car (last usingname)))
1531 ;; We have found the correct tag.
1532 (setq result (semantic-tag-type (car usings))))))
1533 (setq usings (cdr usings))))
1534 result))
1535
1536
1537(define-mode-local-override semantic-analyze-dereference-metatype
1538 c-mode (type scope &optional type-declaration)
1539 "Dereference TYPE as described in `semantic-analyze-dereference-metatype'.
1540Handle typedef, template instantiation, and '->' operator."
1541 (let* ((dereferencer-list '(semantic-c-dereference-typedef
1542 semantic-c-dereference-template
1543 semantic-c-dereference-member-of
1544 semantic-c-dereference-namespace))
1545 (dereferencer (pop dereferencer-list))
1546 (type-tuple)
1547 (original-type type))
1548 (while dereferencer
1549 (setq type-tuple (funcall dereferencer type scope type-declaration)
1550 type (car type-tuple)
1551 type-declaration (cadr type-tuple))
1552 (if (not (eq type original-type))
1553 ;; we found a new type so break the dereferencer loop now !
1554 ;; (we will be recalled with the new type expanded by
1555 ;; semantic-analyze-dereference-metatype-stack).
1556 (setq dereferencer nil)
1557 ;; no new type found try the next dereferencer :
1558 (setq dereferencer (pop dereferencer-list)))))
1559 (list type type-declaration))
1560
1561(define-mode-local-override semantic-analyze-type-constants c-mode (type)
91abaf51 1562 "When TYPE is a tag for an enum, return its parts.
4feec2f5
CY
1563These are constants which are of type TYPE."
1564 (if (and (eq (semantic-tag-class type) 'type)
1565 (string= (semantic-tag-type type) "enum"))
1566 (semantic-tag-type-members type)))
1567
4feec2f5
CY
1568(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist)
1569 "Assemble the list of names NAMELIST into a namespace name."
1570 (mapconcat 'identity namelist "::"))
1571
1572(define-mode-local-override semantic-ctxt-scoped-types c++-mode (&optional point)
1573 "Return a list of tags of CLASS type based on POINT.
1574DO NOT return the list of tags encompassing point."
1575 (when point (goto-char (point)))
1576 (let ((tagsaroundpoint (semantic-find-tag-by-overlay))
1577 (tagreturn nil)
1578 (tmp nil))
1579 ;; In C++, we want to find all the namespaces declared
1580 ;; locally and add them to the list.
1581 (setq tmp (semantic-find-tags-by-class 'type (current-buffer)))
1582 (setq tmp (semantic-find-tags-by-type "namespace" tmp))
1583 (setq tmp (semantic-find-tags-by-name "unnamed" tmp))
1584 (setq tagreturn tmp)
1585 ;; We should also find all "using" type statements and
1586 ;; accept those entities in as well.
1587 (setq tmp (semanticdb-find-tags-by-class 'using))
1588 (let ((idx 0)
1589 (len (semanticdb-find-result-length tmp)))
1590 (while (< idx len)
1591 (setq tagreturn (cons (semantic-tag-type (car (semanticdb-find-result-nth tmp idx))) tagreturn))
1592 (setq idx (1+ idx)))
1593 )
1594 ;; Use the encompased types around point to also look for using statements.
1595 ;;(setq tagreturn (cons "bread_name" tagreturn))
1596 (while (cdr tagsaroundpoint) ; don't search the last one
1597 (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
1598 (dolist (T tmp)
1599 (setq tagreturn (cons (semantic-tag-type T) tagreturn))
1600 )
1601 (setq tagsaroundpoint (cdr tagsaroundpoint))
1602 )
1603 ;; If in a function...
1604 (when (and (semantic-tag-of-class-p (car tagsaroundpoint) 'function)
1605 ;; ...search for using statements in the local scope...
1606 (setq tmp (semantic-find-tags-by-class
1607 'using
1608 (semantic-get-local-variables))))
1609 ;; ... and add them.
1610 (setq tagreturn
1611 (append tagreturn
1612 (mapcar 'semantic-tag-type tmp))))
1613 ;; Return the stuff
1614 tagreturn
1615 ))
1616
dd9af436
CY
1617(define-mode-local-override semantic-ctxt-imported-packages c++-mode (&optional point)
1618 "Return the list of using tag types in scope of POINT."
1619 (when point (goto-char (point)))
1620 (let ((tagsaroundpoint (semantic-find-tag-by-overlay))
1621 (namereturn nil)
1622 (tmp nil)
1623 )
1624 ;; Collect using statements from the top level.
1625 (setq tmp (semantic-find-tags-by-class 'using (current-buffer)))
1626 (dolist (T tmp) (setq namereturn (cons (semantic-tag-type T) namereturn)))
1627 ;; Move through the tags around point looking for more using statements
1628 (while (cdr tagsaroundpoint) ; don't search the last one
1629 (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
1630 (dolist (T tmp) (setq namereturn (cons (semantic-tag-type T) namereturn)))
1631 (setq tagsaroundpoint (cdr tagsaroundpoint))
1632 )
1633 namereturn))
1634
1635(define-mode-local-override semanticdb-expand-nested-tag c++-mode (tag)
1636 "Expand TAG if it has a fully qualified name.
1637For types with a :parent, create faux namespaces to put TAG into."
1638 (let ((p (semantic-tag-get-attribute tag :parent)))
1639 (if (and p (semantic-tag-of-class-p tag 'type))
1640 ;; Expand the tag
1641 (let ((s (semantic-analyze-split-name p))
1642 (newtag (semantic-tag-copy tag nil t)))
1643 ;; Erase the qualified name.
1644 (semantic-tag-put-attribute newtag :parent nil)
1645 ;; Fixup the namespace name
1646 (setq s (if (stringp s) (list s) (nreverse s)))
1647 ;; Loop over all the parents, creating the nested
1648 ;; namespace.
1649 (require 'semantic/db-typecache)
1650 (dolist (namespace s)
1651 (setq newtag (semanticdb-typecache-faux-namespace
1652 namespace (list newtag)))
1653 )
1654 ;; Return the last created namespace.
1655 newtag)
1656 ;; Else, return tag unmodified.
1657 tag)))
1658
4feec2f5
CY
1659(define-mode-local-override semantic-get-local-variables c++-mode ()
1660 "Do what `semantic-get-local-variables' does, plus add `this' if needed."
1661 (let* ((origvar (semantic-get-local-variables-default))
1662 (ct (semantic-current-tag))
1663 (p (semantic-tag-function-parent ct)))
1664 ;; If we have a function parent, then that implies we can
1665 (if (and p (semantic-tag-of-class-p ct 'function))
1666 ;; Append a new tag THIS into our space.
1667 (cons (semantic-tag-new-variable "this" p nil)
1668 origvar)
1669 ;; No parent, just return the usual
1670 origvar)
1671 ))
1672
1673(define-mode-local-override semantic-idle-summary-current-symbol-info
1674 c-mode ()
1675 "Handle the SPP keywords, then use the default mechanism."
1676 (let* ((sym (car (semantic-ctxt-current-thing)))
1677 (spp-sym (semantic-lex-spp-symbol sym)))
1678 (if spp-sym
1679 (let* ((txt (concat "Macro: " sym))
1680 (sv (symbol-value spp-sym))
1681 (arg (semantic-lex-spp-macro-with-args sv))
1682 )
1683 (when arg
1684 (setq txt (concat txt (format "%S" arg)))
1685 (setq sv (cdr sv)))
1686
1687 ;; This is optional, and potentially fraught w/ errors.
1688 (condition-case nil
1689 (dolist (lt sv)
1690 (setq txt (concat txt " " (semantic-lex-token-text lt))))
1691 (error (setq txt (concat txt " #error in summary fcn"))))
1692
1693 txt)
1694 (semantic-idle-summary-current-symbol-info-default))))
1695
1696(defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct"
91abaf51 1697 "When lost members are found in the class hierarchy generator, use a struct.")
4feec2f5
CY
1698
1699(defvar-mode-local c-mode semantic-symbol->name-assoc-list
1700 '((type . "Types")
1701 (variable . "Variables")
1702 (function . "Functions")
1703 (include . "Includes")
1704 )
1705 "List of tag classes, and strings to describe them.")
1706
1707(defvar-mode-local c-mode semantic-symbol->name-assoc-list-for-type-parts
1708 '((type . "Types")
1709 (variable . "Attributes")
1710 (function . "Methods")
1711 (label . "Labels")
1712 )
1713 "List of tag classes in a datatype decl, and strings to describe them.")
1714
1715(defvar-mode-local c-mode imenu-create-index-function 'semantic-create-imenu-index
1716 "Imenu index function for C.")
1717
1718(defvar-mode-local c-mode semantic-type-relation-separator-character
1719 '("." "->" "::")
1720 "Separator characters between something of a given type, and a field.")
1721
1722(defvar-mode-local c-mode semantic-command-separation-character ";"
91abaf51 1723 "Command separation character for C.")
4feec2f5
CY
1724
1725(defvar-mode-local c-mode senator-step-at-tag-classes '(function variable)
1726 "Tag classes where senator will stop at the end.")
1727
a60f2e7b 1728;;;###autoload
4feec2f5
CY
1729(defun semantic-default-c-setup ()
1730 "Set up a buffer for semantic parsing of the C language."
1731 (semantic-c-by--install-parser)
1732 (setq semantic-lex-syntax-modifications '((?> ".")
1733 (?< ".")
1734 )
1735 )
1736
1737 (setq semantic-lex-analyzer #'semantic-c-lexer)
1738 (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
1739 )
1740
a60f2e7b 1741;;;###autoload
4feec2f5
CY
1742(defun semantic-c-add-preprocessor-symbol (sym replacement)
1743 "Add a preprocessor symbol SYM with a REPLACEMENT value."
1744 (interactive "sSymbol: \nsReplacement: ")
1745 (let ((SA (assoc sym semantic-lex-c-preprocessor-symbol-map)))
1746 (if SA
1747 ;; Replace if there is one.
1748 (setcdr SA replacement)
1749 ;; Otherwise, append
1750 (setq semantic-lex-c-preprocessor-symbol-map
1751 (cons (cons sym replacement)
1752 semantic-lex-c-preprocessor-symbol-map))))
1753
1754 (semantic-c-reset-preprocessor-symbol-map)
1755 )
1756
4feec2f5
CY
1757;;; SETUP QUERY
1758;;
1759(defun semantic-c-describe-environment ()
1760 "Describe the Semantic features of the current C environment."
1761 (interactive)
1762 (if (not (or (eq major-mode 'c-mode) (eq major-mode 'c++-mode)))
1763 (error "Not useful to query C mode in %s mode" major-mode))
1764 (let ((gcc (when (boundp 'semantic-gcc-setup-data)
1765 semantic-gcc-setup-data))
1766 )
1767 (semantic-fetch-tags)
1768
1769 (with-output-to-temp-buffer "*Semantic C Environment*"
1770 (when gcc
1771 (princ "Calculated GCC Parameters:")
1772 (dolist (P gcc)
1773 (princ "\n ")
1774 (princ (car P))
1775 (princ " = ")
1776 (princ (cdr P))
1777 )
1778 )
1779
1780 (princ "\n\nInclude Path Summary:\n")
1fe1547a 1781 (when (and (boundp 'ede-object) ede-object)
4feec2f5
CY
1782 (princ "\n This file's project include is handled by:\n")
1783 (princ " ")
1784 (princ (object-print ede-object))
1785 (princ "\n with the system path:\n")
1786 (dolist (dir (ede-system-include-path ede-object))
1787 (princ " ")
1788 (princ dir)
1789 (princ "\n"))
1790 )
1791
1792 (when semantic-dependency-include-path
1793 (princ "\n This file's generic include path is:\n")
1794 (dolist (dir semantic-dependency-include-path)
1795 (princ " ")
1796 (princ dir)
1797 (princ "\n")))
1798
1799 (when semantic-dependency-system-include-path
1800 (princ "\n This file's system include path is:\n")
1801 (dolist (dir semantic-dependency-system-include-path)
1802 (princ " ")
1803 (princ dir)
1804 (princ "\n")))
1805
1806 (princ "\n\nMacro Summary:\n")
1807 (when semantic-lex-c-preprocessor-symbol-file
1808 (princ "\n Your CPP table is primed from these files:\n")
1809 (dolist (file semantic-lex-c-preprocessor-symbol-file)
1810 (princ " ")
1811 (princ file)
1812 (princ "\n")
1813 (princ " in table: ")
1814 (princ (object-print (semanticdb-file-table-object file)))
1815 (princ "\n")
1816 ))
1817
1818 (when semantic-lex-c-preprocessor-symbol-map-builtin
1819 (princ "\n Built-in symbol map:\n")
1820 (dolist (S semantic-lex-c-preprocessor-symbol-map-builtin)
1821 (princ " ")
1822 (princ (car S))
1823 (princ " = ")
1824 (princ (cdr S))
1825 (princ "\n")
1826 ))
1827
1828 (when semantic-lex-c-preprocessor-symbol-map
1829 (princ "\n User symbol map:\n")
1830 (dolist (S semantic-lex-c-preprocessor-symbol-map)
1831 (princ " ")
1832 (princ (car S))
1833 (princ " = ")
1834 (princ (cdr S))
1835 (princ "\n")
1836 ))
1837
dd9af436
CY
1838 (when (and (boundp 'ede-object)
1839 ede-object
1840 (arrayp semantic-lex-spp-project-macro-symbol-obarray))
1dc5c6f3 1841 (princ "\n Project symbol map:\n")
1d94ebb0
GM
1842 (when (and (boundp 'ede-object) ede-object)
1843 (princ " Your project symbol map is derived from the EDE object:\n ")
1844 (princ (object-print ede-object)))
1dc5c6f3
CY
1845 (princ "\n\n")
1846 (let ((macros nil))
1847 (mapatoms
1848 #'(lambda (symbol)
1849 (setq macros (cons symbol macros)))
1850 semantic-lex-spp-project-macro-symbol-obarray)
1851 (dolist (S macros)
1852 (princ " ")
1853 (princ (symbol-name S))
1854 (princ " = ")
1855 (princ (symbol-value S))
1856 (princ "\n")
1857 )))
1858
4feec2f5
CY
1859 (princ "\n\n Use: M-x semantic-lex-spp-describe RET\n")
1860 (princ "\n to see the complete macro table.\n")
1861
1862 )))
1863
1864(provide 'semantic/bovine/c)
1865
1866(semantic-c-reset-preprocessor-symbol-map)
1867
a60f2e7b
CY
1868;; Local variables:
1869;; generated-autoload-file: "../loaddefs.el"
a60f2e7b
CY
1870;; generated-autoload-load-name: "semantic/bovine/c"
1871;; End:
1872
4feec2f5 1873;;; semantic/bovine/c.el ends here