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