cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/bovine/semantic-c.el.upstream

   1 ;;; semantic-c.el --- Semantic details for C
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; X-RCS: $Id: semantic-c.el.upstream,v 1.1 2007-12-03 07:04:56 michaels Exp $
   7
   8 ;; This file is not part of GNU Emacs.
   9
  10 ;; This 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 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This software 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26 ;;
  27
  28 ;;; History:
  29 ;;
  30
  31 (require 'semantic)
  32 (require 'semantic-lex-spp)
  33 (require 'semantic-c-by)
  34 (require 'backquote)
  35
  36 (eval-when-compile
  37   (require 'semantic-ctxt)
  38   (require 'semantic-imenu)
  39   (require 'semantic-tag-ls)
  40   (require 'document)
  41   (require 'senator)
  42   (require 'cc-mode))
  43
  44
  45 ;;; Compatibility
  46 ;;
  47 (if (fboundp 'c-end-of-macro)
  48     (eval-and-compile
  49       (defalias 'semantic-c-end-of-macro 'c-end-of-macro))
  50   ;; From cc-mode 5.30
  51   (defun semantic-c-end-of-macro ()
  52     "Go to the end of a preprocessor directive.
  53 More accurately, move point to the end of the closest following line
  54 that doesn't end with a line continuation backslash.
  55
  56 This function does not do any hidden buffer changes."
  57     (while (progn
  58              (end-of-line)
  59              (when (and (eq (char-before) ?\\)
  60                         (not (eobp)))
  61                (forward-char)
  62                t))))
  63   )
  64 ;;-------
  65
  66 ;;; Lexical analysis
  67 (defcustom semantic-lex-c-preprocessor-symbol-map nil
  68   "Table of C Preprocessor keywords used by the Semantic C lexer."
  69   :group 'c
  70   :type '(repeat (cons (string :tag "Keyword")
  71                        (string :tag "Replacement")))
  72   )
  73
  74 ;;; Code:
  75 (define-lex-spp-macro-declaration-analyzer semantic-lex-cpp-define
  76   "A #define of a symbol with some value.
  77 Record the symbol in the semantic preprocessor.
  78 Return the the defined symbol as a special spp lex token."
  79   "^\\s-*#define\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1
  80   (goto-char (match-end 0))
  81   (skip-chars-forward " \t")
  82   (if (eolp)
  83       nil
  84     (prog1
  85         (buffer-substring-no-properties (point)
  86                                         (progn
  87                                           ;; NOTE: THIS SHOULD BE
  88                                           ;; END OF MACRO!!!
  89                                           (forward-word 1)
  90                                           (point)))
  91       ;; Move the lexical end after the value.
  92       (semantic-c-end-of-macro)
  93       ;; Magical spp variable for end point.
  94       (setq semantic-lex-end-point (point))
  95       )))
  96
  97 (define-lex-spp-macro-undeclaration-analyzer semantic-lex-cpp-undef
  98   "A #undef of a symbol.
  99 Remove the symbol from the semantic preprocessor.
 100 Return the the defined symbol as a special spp lex token."
 101   "^\\s-*#undef\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 1)
 102
 103 (defun semantic-c-skip-conditional-section ()
 104   "Skip one section of a conditional.
 105 Moves forward to a matching #elif, #else, or #endif.
 106 Movers completely over balanced #if blocks."
 107   (let ((done nil))
 108     ;; (if (looking-at "^\\s-*#if")
 109     ;; (semantic-lex-spp-push-if (point))
 110     (end-of-line)
 111     (while (and (not done)
 112                 (re-search-forward "^\\s-*#\\(if\\(n?def\\)?\\|el\\(if\\|se\\)\\|endif\\)\\>" nil t))
 113       (goto-char (match-beginning 0))
 114       (cond
 115        ((looking-at "^\\s-*#if")
 116         ;; We found a nested if.  Skip it.
 117         (c-forward-conditional 1))
 118        ((looking-at "^\\s-*#\\(endif\\|else\\)\\>")
 119         ;; We are at the end.  Pop our state.
 120         ;; (semantic-lex-spp-pop-if)
 121         ;; Note: We include ELSE and ENDIF the same. If skip some previous
 122         ;; section, then we should do the else by default, making it much
 123         ;; like the endif.
 124         (end-of-line)
 125         (forward-char 1)
 126         (setq done t))
 127        (t
 128         ;; We found an elif.  Stop here.
 129         (setq done t))))))
 130
 131 (define-lex-regex-analyzer semantic-lex-c-if
 132   "Code blocks wrapped up in #if, or #ifdef.
 133 Uses known macro tables in SPP to determine what block to skip."
 134   "^\\s-*#\\(if\\|ifndef\\|ifdef\\|elif\\)\\s-+\\(!?defined(\\|\\)\\(\\(\\sw\\|\\s_\\)+\\))?\\s-*$"
 135   (let* ((sym (buffer-substring-no-properties
 136                (match-beginning 3) (match-end 3)))
 137          (defstr (buffer-substring-no-properties
 138                   (match-beginning 2) (match-end 2)))
 139          (defined (string= defstr "defined("))
 140          (notdefined (string= defstr "!defined("))
 141          (ift (buffer-substring-no-properties
 142                (match-beginning 1) (match-end 1)))
 143          (ifdef (or (string= ift "ifdef")
 144                     (and (string= ift "if") defined)
 145                     (and (string= ift "elif") defined)
 146                     ))
 147          (ifndef (or (string= ift "ifndef")
 148                      (and (string= ift "if") notdefined)
 149                      (and (string= ift "elif") notdefined)
 150                      ))
 151          )
 152     (if (or (and (or (string= ift "if") (string= ift "elif"))
 153                  (string= sym "0"))
 154             (and ifdef (not (semantic-lex-spp-symbol-p sym)))
 155             (and ifndef (semantic-lex-spp-symbol-p sym)))
 156         ;; The if indecates to skip this preprocessor section
 157         (let ((pt nil))
 158           ;; (message "%s %s yes" ift sym)
 159           (beginning-of-line)
 160           (setq pt (point))
 161           ;;(c-forward-conditional 1)
 162           ;; This skips only a section of a conditional.  Once that section
 163           ;; is opened, encountering any new #else or related conditional
 164           ;; should be skipped.
 165           (semantic-c-skip-conditional-section)
 166           (setq semantic-lex-end-point (point))
 167           (semantic-push-parser-warning (format "Skip #%s %s" ift sym)
 168                                         pt (point))
 169 ;;        (semantic-lex-push-token
 170 ;;         (semantic-lex-token 'c-preprocessor-skip pt (point)))
 171           nil)
 172       ;; Else, don't ignore it, but do handle the internals.
 173       ;;(message "%s %s no" ift sym)
 174       (end-of-line)
 175       (setq semantic-lex-end-point (point))
 176       nil)))
 177
 178 (define-lex-regex-analyzer semantic-lex-c-macro-else
 179   "Ignore an #else block.
 180 We won't see the #else due to the macro skip section block
 181 unless we are actively parsing an open #if statement.  In that
 182 case, we must skip it since it is the ELSE part."
 183   "^#\\(else\\)"
 184   (let ((pt (point)))
 185     (semantic-c-skip-conditional-section)
 186     (setq semantic-lex-end-point (point))
 187     (semantic-push-parser-warning "Skip #else" pt (point))
 188 ;;    (semantic-lex-push-token
 189 ;;     (semantic-lex-token 'c-preprocessor-skip pt (point)))
 190     nil))
 191
 192 (define-lex-regex-analyzer semantic-lex-c-macrobits
 193   "Ignore various forms of #if/#else/#endif conditionals."
 194   "^#\\(if\\(def\\)?\\|endif\\)"
 195   (semantic-c-end-of-macro)
 196   (setq semantic-lex-end-point (point))
 197   nil)
 198
 199 (define-lex-analyzer semantic-lex-c-include-system
 200   "Identify system include strings, and return special tokens."
 201   (and (looking-at "<[^\n>]+>")
 202        (save-excursion
 203          (beginning-of-line)
 204          (looking-at "\\s-*#\\s-*include\\s-+<"))
 205        (= (match-end 0) (1+ (point))))
 206   ;; We found a system include.
 207   (let ((start (point)))
 208     ;; This should always pass
 209     (re-search-forward ">")
 210     ;; We have the whole thing.
 211     (semantic-lex-push-token
 212      (semantic-lex-token 'system-include start (point)))
 213     )
 214   )
 215
 216 (define-lex-regex-analyzer semantic-lex-c-ignore-ending-backslash
 217   "Skip backslash ending a line.
 218 Go to the next line."
 219   "\\\\\\s-*\n"
 220   (setq semantic-lex-end-point (match-end 0)))
 221
 222 (define-lex-regex-analyzer semantic-lex-c-string
 223   "Detect and create a C string token."
 224   "L?\\(\\s\"\\)"
 225   ;; Zing to the end of this string.
 226   (semantic-lex-push-token
 227    (semantic-lex-token
 228     'string (point)
 229     (save-excursion
 230       ;; Skip L prefix if present.
 231       (goto-char (match-beginning 1))
 232       (semantic-lex-unterminated-syntax-protection 'string
 233         (forward-sexp 1)
 234         (point))
 235       ))))
 236
 237 (define-lex semantic-c-lexer
 238   "Lexical Analyzer for C code."
 239   semantic-lex-ignore-whitespace
 240   semantic-lex-ignore-newline
 241   ;; C preprocessor features
 242   semantic-lex-cpp-define
 243   semantic-lex-cpp-undef
 244   semantic-lex-c-if
 245   semantic-lex-c-macro-else
 246   semantic-lex-c-macrobits
 247   semantic-lex-c-include-system
 248   semantic-lex-c-ignore-ending-backslash
 249   ;; Non-preprocessor features
 250   semantic-lex-number
 251   ;; Must detect C strings before symbols because of possible L prefix!
 252   semantic-lex-c-string
 253   semantic-lex-spp-replace-or-symbol-or-keyword
 254   semantic-lex-charquote
 255   semantic-lex-paren-or-list
 256   semantic-lex-close-paren
 257   semantic-lex-ignore-comments
 258   semantic-lex-punctuation
 259   semantic-lex-default-action)
 260
 261 (defun semantic-expand-c-tag (tag)
 262   "Expand TAG into a list of equivalent tags, or nil."
 263   (cond ((eq (semantic-tag-class tag) 'extern)
 264          ;; We have hit an exter "C" command with a list after it.
 265          (let* ((mb (semantic-tag-get-attribute tag :members))
 266                 (ret mb))
 267            (while mb
 268              (let ((mods (semantic-tag-get-attribute (car mb) :typemodifiers)))
 269                (setq mods (cons "extern" (cons "\"C\"" mods)))
 270                (semantic-tag-put-attribute (car mb) :typemodifiers mods))
 271              (setq mb (cdr mb)))
 272            ret))
 273         ((listp (car tag))
 274          (cond ((eq (semantic-tag-class tag) 'variable)
 275                 ;; The name part comes back in the form of:
 276                 ;; ( NAME NUMSTARS BITS ARRAY ASSIGN )
 277                 (let ((vl nil)
 278                       (basety (semantic-tag-type tag))
 279                       (ty "")
 280                       (mods (semantic-tag-get-attribute tag :typemodifiers))
 281                       (suffix "")
 282                       (lst (semantic-tag-name tag))
 283                       (default nil)
 284                       (cur nil))
 285                   (while lst
 286                     (setq suffix "" ty "")
 287                     (setq cur (car lst))
 288                     (if (nth 2 cur)
 289                         (setq suffix (concat ":" (nth 2 cur))))
 290                     (if (= (length basety) 1)
 291                         (setq ty (car basety))
 292                       (setq ty basety))
 293                     (setq default (nth 4 cur))
 294                     (setq vl (cons
 295                               (semantic-tag-new-variable
 296                                (car cur) ;name
 297                                ty       ;type
 298                                (if default
 299                                    (buffer-substring-no-properties
 300                                     (car default) (car (cdr default))))
 301                                :constant-flag (semantic-tag-variable-constant-p tag)
 302                                :suffix suffix
 303                                :typemodifiers mods
 304                                :dereference (length (nth 3 cur))
 305                                :pointer (nth 1 cur)
 306                                :documentation (semantic-tag-docstring tag) ;doc
 307                                )
 308                               vl))
 309                     (semantic--tag-copy-properties tag (car vl))
 310                     (semantic--tag-set-overlay (car vl)
 311                                                (semantic-tag-overlay tag))
 312                     (setq lst (cdr lst)))
 313                   vl))
 314                ((eq (semantic-tag-class tag) 'type)
 315                 ;; We may someday want to add an extra check for a type
 316                 ;; of type "typedef".
 317                 ;; Each elt of NAME is ( STARS NAME )
 318                 (let ((vl nil)
 319                       (names (semantic-tag-name tag)))
 320                   (while names
 321                     (setq vl (cons (semantic-tag-new-type
 322                                     (nth 1 (car names)) ; name
 323                                     "typedef"
 324                                     (semantic-tag-type-members tag)
 325                                     ;; parent is just tbe name of what
 326                                     ;; is passed down as a tag.
 327                                     (list
 328                                      (semantic-tag-name
 329                                       (semantic-tag-type-superclasses tag)))
 330                                     :pointer
 331                                     (let ((stars (car (car (car names)))))
 332                                       (if (= stars 0) nil stars))
 333                                     ;; This specifies what the typedef
 334                                     ;; is expanded out as.  Just the
 335                                     ;; name shows up as a parent of this
 336                                     ;; typedef.
 337                                     :typedef
 338                                     (semantic-tag-type-superclasses tag)
 339                                     :documentation
 340                                     (semantic-tag-docstring tag))
 341                                    vl))
 342                     (semantic--tag-copy-properties tag (car vl))
 343                     (semantic--tag-set-overlay (car vl)
 344                                                (semantic-tag-overlay tag))
 345                     (setq names (cdr names)))
 346                   vl))
 347                ((and (listp (car tag))
 348                      (eq (semantic-tag-class (car tag)) 'variable))
 349                 ;; Argument lists come in this way.  Append all the expansions!
 350                 (let ((vl nil))
 351                   (while tag
 352                     (setq vl (append (semantic-tag-components (car vl))
 353                                      vl)
 354                           tag (cdr tag)))
 355                   vl))
 356                (t nil)))
 357         (t nil)))
 358
 359 (defvar-mode-local c-mode semantic-tag-expand-function 'semantic-expand-c-tag
 360   "Function used to expand tags generated in the C bovine parser.")
 361
 362 (defvar semantic-c-classname nil
 363   "At parse time, assign a class or struct name text here.
 364 It is picked up by `semantic-c-reconstitute-token' to determine
 365 if something is a constructor.  Value should be:
 366   ( TYPENAME .  TYPEOFTYPE)
 367 where typename is the name of the type, and typeoftype is \"class\"
 368 or \"struct\".")
 369
 370 (defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
 371   "Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
 372 This is so we don't have to match the same starting text several times.
 373 Optional argument STAR and REF indicate the number of * and & in the typedef."
 374   (when (and (listp typedecl)
 375              (= 1 (length typedecl))
 376              (stringp (car typedecl)))
 377     (setq typedecl (car typedecl)))
 378   (cond ((eq (nth 1 tokenpart) 'variable)
 379          (semantic-tag-new-variable
 380           (car tokenpart)
 381           (or typedecl "int")   ;type
 382           nil                   ;default value (filled with expand)
 383           :constant-flag (if (member "const" declmods) t nil)
 384           :typemodifiers (delete "const" declmods)
 385           )
 386          )
 387         ((eq (nth 1 tokenpart) 'function)
 388          ;; We should look at part 4 (the arglist) here, and throw an
 389          ;; error of some sort if it contains parser errors so that we
 390          ;; don't parser function calls, but that is a little beyond what
 391          ;; is available for data here.
 392          (let* ((constructor
 393                  (and (or (and semantic-c-classname
 394                                (string= (car semantic-c-classname)
 395                                         (car tokenpart)))
 396                           (and (stringp (car (nth 2 tokenpart)))
 397                                (string= (car (nth 2 tokenpart)) (car tokenpart)))
 398                           )
 399                       (not (car (nth 3 tokenpart)))))
 400                 (fcnpointer (string-match "^\\*" (car tokenpart)))
 401                 (fnname (if fcnpointer
 402                             (substring (car tokenpart) 1)
 403                           (car tokenpart)))
 404                 (operator (if (string-match "[a-zA-Z]" fnname)
 405                               nil
 406                             t))
 407                 )
 408            (if fcnpointer
 409                ;; Function pointers are really variables.
 410                (semantic-tag-new-variable
 411                 fnname
 412                 typedecl
 413                 nil
 414                 ;; It is a function pointer
 415                 :functionpointer-flag t
 416                 )
 417              ;; The function
 418              (semantic-tag-new-function
 419               fnname
 420               (or typedecl              ;type
 421                   (cond ((car (nth 3 tokenpart) )
 422                          "void")        ; Destructors have no return?
 423                         (constructor
 424                          ;; Constructors return an object.
 425                          (semantic-tag-new-type
 426                           ;; name
 427                           (or (car semantic-c-classname)
 428                               (car (nth 2 tokenpart)))
 429                           ;; type
 430                           (or (cdr semantic-c-classname)
 431                               "class")
 432                           ;; members
 433                           nil
 434                           ;; parents
 435                           nil
 436                           ))
 437                         (t "int")))
 438               (nth 4 tokenpart)         ;arglist
 439               :constant-flag (if (member "const" declmods) t nil)
 440               :typemodifiers (delete "const" declmods)
 441               :parent (car (nth 2 tokenpart))
 442               :destructor-flag (if (car (nth 3 tokenpart) ) t)
 443               :constructor-flag (if constructor t)
 444               :pointer (nth 7 tokenpart)
 445               :operator-flag operator
 446               ;; Even though it is "throw" in C++, we use
 447               ;; `throws' as a common name for things that toss
 448               ;; exceptions about.
 449               :throws (nth 5 tokenpart)
 450               ;; Reemtrant is a C++ thingy.  Add it here
 451               :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
 452               ;; A function post-const is funky.  Try stuff
 453               :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
 454               ;; prototypes are functions w/ no body
 455               :prototype-flag (if (nth 8 tokenpart) t)
 456               ;; Pure virtual
 457               :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
 458               )))
 459          )
 460         ))
 461
 462 (defun semantic-c-reconstitute-template (tag specifier)
 463   "Reconstitute the token TAG with the template SPECIFIER."
 464   (semantic-tag-put-attribute tag :template (or specifier ""))
 465   tag)
 466 \f
 467 ;;; Override methods & Variables
 468 ;;
 469 (defvar-mode-local c-mode semantic-dependency-system-include-path
 470   '("/usr/include" "/usr/dt/include" "/usr/X11R6/include")
 471   "System path to search for include files.")
 472
 473 (defcustom semantic-default-c-path nil
 474   "Default set of include paths for C code.
 475 Used by `semantic-dep' to define an include path.
 476 NOTE: In process of obsoleting this."
 477   :group 'c
 478   :group 'semantic
 479   :type '(repeat (string :tag "Path")))
 480
 481 (defvar-mode-local c-mode semantic-dependency-include-path
 482   semantic-default-c-path
 483   "System path to search for include files.")
 484
 485
 486 (define-mode-local-override semantic-format-tag-name
 487   c-mode (tag &optional parent color)
 488   "Convert TAG to a string that is the print name for TAG.
 489 Optional PARENT and COLOR are ignored."
 490   (let ((name (semantic-format-tag-name-default tag parent color))
 491         (fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
 492         )
 493     (if (not fnptr)
 494         name
 495       (concat "(*" name ")"))
 496     ))
 497
 498 (define-mode-local-override semantic-format-tag-canonical-name
 499   c-mode (tag &optional parent color)
 500   "Create a cannonical name for TAG.
 501 PARENT specifies a parent class.
 502 COLOR indicates that the text should be type colorized.
 503 Enhances the base class to search for the entire parent
 504 tree to make the name accurate."
 505   (semantic-format-tag-canonical-name-default tag parent color)
 506   )
 507
 508 (define-mode-local-override semantic-format-tag-type c-mode (tag color)
 509   "Convert the data type of TAG to a string usable in tag formatting.
 510 Adds pointer and reference symbols to the default.
 511 Argument COLOR adds color to the text."
 512   (let* ((type (semantic-tag-type tag))
 513          (defaulttype nil)
 514          (point (semantic-tag-get-attribute tag :pointer))
 515          (ref (semantic-tag-get-attribute tag :reference))
 516          )
 517     (if (semantic-tag-p type)
 518         (let ((typetype (semantic-tag-type type))
 519               (typename (semantic-tag-name type)))
 520           ;; Create the string that expresses the type
 521           (if (string= typetype "class")
 522               (setq defaulttype typename)
 523             (setq defaulttype (concat typetype " " typename))))
 524       (setq defaulttype (semantic-format-tag-type-default tag color)))
 525
 526     ;; Colorize
 527     (when color
 528       (setq defaulttype (semantic--format-colorize-text defaulttype 'type)))
 529
 530     ;; Add refs, ptrs, etc
 531     (if ref (setq ref "&"))
 532     (if point (setq point (make-string point ?*)) "")
 533     (when type
 534       (concat defaulttype ref point))
 535     ))
 536
 537 (define-mode-local-override semantic-tag-protection
 538   c-mode (token &optional parent)
 539   "Return the protection of TOKEN in PARENT.
 540 Override function for `semantic-tag-protection'."
 541   (let ((mods (semantic-tag-modifiers token))
 542         (prot nil))
 543     ;; Check the modifiers for protection if we are not a child
 544     ;; of some class type.
 545     (when (or (not parent) (not (eq (semantic-tag-class parent) 'type)))
 546       (while (and (not prot) mods)
 547         (if (stringp (car mods))
 548             (let ((s (car mods)))
 549               ;; A few silly defaults to get things started.
 550               (cond ((or (string= s "extern")
 551                          (string= s "export"))
 552                      'public)
 553                     ((string= s "static")
 554                      'private))))
 555         (setq mods (cdr mods))))
 556     ;; If we have a typed parent, look for :public style labels.
 557     (when (and parent (eq (semantic-tag-class parent) 'type))
 558       (let ((pp (semantic-tag-type-members parent)))
 559         (while (and pp (not (semantic-equivalent-tag-p (car pp) token)))
 560           (when (eq (semantic-tag-class (car pp)) 'label)
 561             (setq prot
 562                   (cond ((string= (semantic-tag-name (car pp)) "public")
 563                          'public)
 564                         ((string= (semantic-tag-name (car pp)) "private")
 565                          'private)
 566                         ((string= (semantic-tag-name (car pp)) "protected")
 567                          'protected)))
 568             )
 569           (setq pp (cdr pp)))))
 570     (when (and (not prot) (eq (semantic-tag-class parent) 'type))
 571       (setq prot
 572             (cond ((string= (semantic-tag-type parent) "class") 'private)
 573                   ((string= (semantic-tag-type parent) "struct") 'public)
 574                   (t 'unknown))))
 575     (or prot
 576         (if (and parent (semantic-tag-of-class-p parent 'type))
 577             'public
 578           nil))))
 579
 580 (define-mode-local-override semantic-tag-components c-mode (tag)
 581   "Return components for TAG."
 582   (if (and (eq (semantic-tag-class tag) 'type)
 583            (string= (semantic-tag-type tag) "typedef"))
 584       ;; A typedef can contain a parent who has positional children,
 585       ;; but that parent will not have a position.  Do this funny hack
 586       ;; to make sure we can apply overlays properly.
 587       (semantic-tag-components (semantic-tag-type-superclasses tag))
 588     (semantic-tag-components-default tag)))
 589
 590 (defun semantic-c-tag-template (tag)
 591   "Return the template specification for TAG, or nil."
 592   (semantic-tag-get-attribute tag :template))
 593
 594 (defun semantic-c-tag-template-specifier (tag)
 595   "Return the template specifier specification for TAG, or nil."
 596   (semantic-tag-get-attribute tag :template-specifier))
 597
 598 (defun semantic-c-template-string-body (templatespec)
 599   "Convert TEMPLATESPEC into a string.
 600 This might be a string, or a list of tokens."
 601   (cond ((stringp templatespec)
 602          templatespec)
 603         ((semantic-tag-p templatespec)
 604          (semantic-format-tag-abbreviate templatespec))
 605         ((listp templatespec)
 606          (mapconcat 'semantic-format-tag-abbreviate templatespec ", "))))
 607
 608 (defun semantic-c-template-string (token &optional parent color)
 609   "Return a string representing the TEMPLATE attribute of TOKEN.
 610 This string is prefixed with a space, or is the empty string.
 611 Argument PARENT specifies a parent type.
 612 Argument COLOR specifies that the string should be colorized."
 613   (let ((t2 (semantic-c-tag-template-specifier token))
 614         (t1 (semantic-c-tag-template token))
 615         (pt1 (if parent (semantic-c-tag-template parent)))
 616         (pt2 (if parent (semantic-c-tag-template-specifier parent)))
 617         )
 618     (cond (t2 ;; we have a template with specifier
 619            (concat " <"
 620                    ;; Fill in the parts here
 621                    (semantic-c-template-string-body t2)
 622                    ">"))
 623           (t1 ;; we have a template without specifier
 624            " <>")
 625           (t
 626            ""))))
 627
 628 (define-mode-local-override semantic-format-tag-concise-prototype
 629   c-mode (token &optional parent color)
 630   "Return an abbreviated string describing TOKEN for C and C++.
 631 Optional PARENT and COLOR as specified with
 632 `semantic-format-tag-abbreviate-default'."
 633   ;; If we have special template things, append.
 634   (concat  (semantic-format-tag-concise-prototype-default token parent color)
 635            (semantic-c-template-string token parent color)))
 636
 637 (define-mode-local-override semantic-format-tag-uml-prototype
 638   c-mode (token &optional parent color)
 639   "Return an uml string describing TOKEN for C and C++.
 640 Optional PARENT and COLOR as specified with
 641 `semantic-abbreviate-tag-default'."
 642   ;; If we have special template things, append.
 643   (concat  (semantic-format-tag-uml-prototype-default token parent color)
 644            (semantic-c-template-string token parent color)))
 645
 646 (define-mode-local-override semantic-tag-abstract-p
 647   c-mode (tag &optional parent)
 648   "Return non-nil if TAG is considered abstract.
 649 PARENT is tag's parent.
 650 In C, a method is abstract if it is `virtual', which is already
 651 handled.  A class is abstract iff it's destructor is virtual."
 652   (cond
 653    ((eq (semantic-tag-class tag) 'type)
 654     (or (semantic-brute-find-tag-by-attribute :pure-virtual-flag
 655                                               (semantic-tag-components tag)
 656                                               )
 657         (let* ((ds (semantic-brute-find-tag-by-attribute
 658                     :destructor-flag
 659                     (semantic-tag-components tag)
 660                     ))
 661                (cs (semantic-brute-find-tag-by-attribute
 662                     :constructor-flag
 663                     (semantic-tag-components tag)
 664                     )))
 665           (and ds (member "virtual" (semantic-tag-modifiers (car ds)))
 666                cs (eq 'protected (semantic-tag-protection (car cs) tag))
 667                )
 668           )))
 669    ((eq (semantic-tag-class tag) 'function)
 670     (or (semantic-tag-get-attribute tag :pure-virtual-flag)
 671         (member "virtual" (semantic-tag-modifiers tag))))
 672    (t (semantic-tag-abstract-p-default tag parent))))
 673
 674 (define-mode-local-override semantic-analyze-dereference-metatype
 675   c-mode (type scope)
 676   "Dereference TYPE as described in `semantic-analyze-dereference-metatype'.
 677 If TYPE is a typedef, get TYPE's type by name or tag, and return."
 678   (if (and (eq (semantic-tag-class type) 'type)
 679            (string= (semantic-tag-type type) "typedef"))
 680       (semantic-tag-get-attribute type :typedef)
 681     type))
 682
 683 (define-mode-local-override semantic-analyze-type-constants c-mode (type)
 684   "When TYPE is a tag for an enum, return it's parts.
 685 These are constants which are of type TYPE."
 686   (if (and (eq (semantic-tag-class type) 'type)
 687            (string= (semantic-tag-type type) "enum"))
 688       (semantic-tag-type-members type)))
 689
 690 (define-mode-local-override semantic-analyze-split-name c-mode (name)
 691   "Split up tag names on colon (:) boundaries."
 692   (let ((ans (split-string name ":")))
 693     (if (= (length ans) 1)
 694         name
 695       (delete "" ans))))
 696
 697 (define-mode-local-override semantic-ctxt-scoped-types c-mode (&optional point)
 698   "Return a list of tags of CLASS type based on POINT.
 699 DO NOT return the list of tags encompassing point."
 700   (when point (goto-char (point)))
 701   (let ((tagreturn nil)
 702         (tmp nil))
 703     ;; In C++, we want to find all the namespaces declared
 704     ;; locally and add them to the list.
 705     (setq tmp (semantic-find-tags-by-class 'type (current-buffer)))
 706     (setq tmp (semantic-find-tags-by-type "namespace" tmp))
 707     (setq tagreturn tmp)
 708     ;; We should also find all "using" type statements and
 709     ;; accept those entities in as well.
 710
 711     ;; Return the stuff
 712     tagreturn
 713     ))
 714
 715 (defvar-mode-local c-mode semantic-orphaned-member-metaparent-type "struct"
 716   "When lost memberes are found in the class hierarchy generator, use a struct.")
 717
 718 (defvar-mode-local c-mode semantic-symbol->name-assoc-list
 719   '((type     . "Types")
 720     (variable . "Variables")
 721     (function . "Functions")
 722     (include  . "Includes")
 723     )
 724   "List of tag classes, and strings to describe them.")
 725
 726 (defvar-mode-local c-mode semantic-symbol->name-assoc-list-for-type-parts
 727   '((type     . "Types")
 728     (variable . "Attributes")
 729     (function . "Methods")
 730     (label    . "Labels")
 731     )
 732   "List of tag classes in a datatype decl, and strings to describe them.")
 733
 734 (defvar-mode-local c-mode imenu-create-index-function 'semantic-create-imenu-index
 735   "Imenu index function for C.")
 736
 737 (defvar-mode-local c-mode semantic-type-relation-separator-character
 738   '("." "->")
 739   "Separator characters between something of a give type, and a field.")
 740
 741 (defvar-mode-local c-mode semantic-command-separation-character ";"
 742   "Commen separation character for C")
 743
 744 (defvar-mode-local c-mode document-comment-start "/*"
 745   "Comment start string.")
 746
 747 (defvar-mode-local c-mode document-comment-line-prefix " *"
 748   "Tween line comment decoration character.")
 749
 750 (defvar-mode-local c-mode document-comment-end " */"
 751   "Comment termination string.")
 752
 753 (defvar-mode-local c-mode senator-step-at-tag-classes '(function variable)
 754   "Tag classes where senator will stop at the end.")
 755
 756 ;;;###autoload
 757 (defun semantic-default-c-setup ()
 758   "Set up a buffer for semantic parsing of the C language."
 759   (semantic-c-by--install-parser)
 760   (setq semantic-lex-syntax-modifications '((?> ".")
 761                                             (?< ".")
 762                                             )
 763         )
 764
 765   (setq semantic-lex-analyzer #'semantic-c-lexer)
 766   (setq semantic-lex-spp-macro-symbol-obarray
 767         (semantic-lex-make-spp-table semantic-lex-c-preprocessor-symbol-map))
 768   (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
 769   )
 770
 771 ;;;###autoload
 772 (defun semantic-c-add-preprocessor-symbol (sym replacement)
 773   "Add a preprocessor symbol SYM with a REPLACEMENT value."
 774   (interactive "sSymbol: \nsReplacement: ")
 775   (let ((SA (assoc sym semantic-lex-c-preprocessor-symbol-map)))
 776     (if SA
 777         ;; Replace if there is one.
 778         (setcdr SA replacement)
 779       ;; Otherwise, append
 780       (setq semantic-lex-c-preprocessor-symbol-map
 781             (cons  (cons sym replacement)
 782                    semantic-lex-c-preprocessor-symbol-map))))
 783   (setq-mode-local c-mode
 784                    semantic-lex-spp-macro-symbol-obarray
 785                    (semantic-lex-make-spp-table
 786                     semantic-lex-c-preprocessor-symbol-map)))
 787
 788 ;;;###autoload
 789 (add-hook 'c-mode-hook 'semantic-default-c-setup)
 790 ;;;###autoload
 791 (add-hook 'c++-mode-hook 'semantic-default-c-setup)
 792
 793 (define-child-mode c++-mode c-mode
 794   "`c++-mode' uses the same parser as `c-mode'.")
 795
 796 (provide 'semantic-c)
 797
 798 ;;; semantic-c.el ends here
 799