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