cc-ide/cc-engine-2.el

   1 ;;; cc-engine-2.el --- Extensuions to cc-engine.el
   2 ;;
   3 ;; $Id$
   4 ;;
   5 ;; Copyright (C) 2000 Stefan Bund
   6
   7 ;; cc-engine-2.el is free software; you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation; either version 2, or (at
  10 ;; your option) any later version.
  11
  12 ;; cc-engine-2.el is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;;; Commentary:
  18
  19 ;;; Change-Log:
  20
  21 ;; $Log$
  22 ;;
  23
  24 ;;; Variables:
  25
  26 (defconst c-template-arglist-syntax
  27   (let ((table (copy-syntax-table c-mode-syntax-table)))
  28     (modify-syntax-entry ?< "(" table)
  29     (modify-syntax-entry ?> ")" table)
  30     table))
  31
  32 (defconst c-any-key
  33   (eval-when-compile
  34     (concat (regexp-opt '("break" "continue" "do" "else" "for" "if"
  35                           "return" "switch" "while" "sizeof" "typedef"
  36                           "extern" "auto" "register" "static" "friend"
  37                           "volatile" "const" "restrict" "enum"
  38                           "struct" "union" "class" "char" "short"
  39                           "int" "long" "signed" "unsigned" "float"
  40                           "double" "void" "complex" "case" "goto"
  41                           "inline" "try" "catch" "throw" "inline_"
  42                           "throw_" "virtual" "new" "delete" "explicit"
  43                           "prefix_" "typename" "template") t)
  44             "\\b[^_]")))
  45
  46 (defconst c-blocking-key
  47   (eval-when-compile
  48     (concat (regexp-opt '("if" "while" "for" "switch")) "\\b[^_]")))
  49
  50 (defconst c-class-scope-key "\\(class\\|struct\\|union\\)\\b[^_]")
  51 (defconst c-namespace-scope-key "namespace\\b[^_]")
  52 (defconst c-scope-key "\\(class\\|struct\\|union\\|namespace\\)");\\b[^_]")
  53 (defconst c-struct-scope-key "struct\\b[^_]")
  54 (defconst c-template-key "template\\b[^_]")
  55 (defconst c-operator-key "operator\\b[^_]")
  56 (defconst c-operator-operators nil)
  57 (defconst c-typedef-key "typedef\\b[^_]")
  58 (defconst c-friend-key "friend\\b[^_]")
  59 (defconst c-access-key "\\(public\\|protected\\|private\\)\\s-*:")
  60 (defconst c-access-keys
  61   '(("public\\s-*:" . public)
  62     ("protected\\s-*:" . protected)
  63     ("private\\s-*:" . private)))
  64 (defconst c-inheritance-spec-key "\\(public\\|protected\\|private\\|virtual\\)\\b[^_]")
  65
  66 (let ((assable '("+" "-" "*" "/" "%" "^" "&" "|" "~" "!" "=" "<" ">" ">>" "<<"))
  67       (others '("&&" "||" "++" "--" "->*" "," "->" "[]" "()" "new" "new[]"
  68                 "delete" "delete[]" "bool")))
  69   (setq c-operator-operators
  70         (regexp-opt (nconc (mapcar (function (lambda (x) (concat x "=")))
  71                                    assable)
  72                            assable others) t)))
  73
  74 (defconst c-operator-word
  75   (concat "operator\\s-*" c-operator-operators))
  76
  77 (defconst c-skip-syntaxes '(?  ?. ?'))
  78
  79 ;;; Code:
  80
  81 (require 'cl)
  82 (require 'cc-engine)
  83 (require 'cc-langs)
  84 (require 'cc-defs)
  85
  86 (defmacro c-with-temporary-syntax-table (table &rest body)
  87   ;; evaluate BODY temporarily binding the syntax table to TABLE
  88   (let ((saved-syntax-table (make-symbol "saved-syntax-table")))
  89     `(let ((,saved-syntax-table (syntax-table)))
  90        (unwind-protect
  91            (progn
  92              (set-syntax-table ,table)
  93              ,@body)
  94          (set-syntax-table ,saved-syntax-table)))))
  95
  96 (def-edebug-spec c-with-temporary-syntax-table (sexp body))
  97 (put 'c-with-temporary-syntax-table 'lisp-indent-function 1)
  98
  99 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100 ;; moving by syntactic entities
 101
 102 (defun c-skip-non-sexp-chars-forward ()
 103   ;; skip char's not considered part of sexps forward
 104   (c-forward-syntactic-ws)
 105   (while (and (not (eq (following-char) ?<))
 106               (memq (char-syntax (following-char)) c-skip-syntaxes)
 107               (not (eobp)))
 108     (forward-char 1)
 109     (c-forward-syntactic-ws)))
 110
 111 (defun c-skip-non-sexp-chars-backward ()
 112   ;; skip char's not considered part of sexps backward
 113   (c-backward-syntactic-ws)
 114   (while (and (not (eq (preceding-char) ?>))
 115               (memq (char-syntax (preceding-char)) c-skip-syntaxes)
 116               (not (bobp)))
 117     (forward-char -1)
 118     (c-backward-syntactic-ws)))
 119
 120 ;; support for teplate arglists
 121
 122 (defun c-forward-template-arglist ()
 123   ;; skip forward over the <> delimited template arglist at
 124   ;; point. This temporarily changes the syntax-table to include <> as
 125   ;; matching delimiters and uses c-forward-sexp
 126   (c-skip-non-sexp-chars-forward)
 127   (if (not (eq (following-char) ?<))
 128       (c-forward-sexp)
 129     (let ((level 1))
 130       (forward-char 1)
 131       (while (and (> level 0)
 132                   (re-search-forward "[[({<>]" nil t))
 133         (if (not (c-in-literal))
 134             (cond ((memq (preceding-char) '(?\[ ?\( ?{))
 135                    (up-list 1))
 136
 137                   ((eq (preceding-char) ?<)
 138                    (setq level (1+ level)))
 139
 140                   ((eq (preceding-char) ?>)
 141                    (setq level (1- level)))))))))
 142
 143 (defun c-backward-template-arglist ()
 144   ;; reverse of c-forward-template-arglist
 145   (c-skip-non-sexp-chars-backward)
 146   (if (not (eq (preceding-char) ?>))
 147       (c-backward-sexp)
 148     (let ((level 1))
 149       (forward-char -1)
 150       (while (and (> level 0)
 151                   (re-search-backward "[])}<>]" nil t))
 152         (if (not (c-in-literal))
 153             (cond ((memq (following-char) '(?\] ?\) ?}))
 154                    (up-list -1))
 155
 156                   ((eq (following-char) ?>)
 157                    (setq level (1+ level)))
 158
 159                   ((eq (following-char) ?<)
 160                    (setq level (1- level)))))))))
 161
 162 (defsubst c-at-symbol-p ()
 163   (memq (char-syntax (following-char)) '(?w ?_)))
 164
 165 (defsubst c-after-symbol-p ()
 166   (memq (char-syntax (preceding-char)) '(?w ?_)))
 167
 168 (defun c-forward-extended-sexp ()
 169   ;; Move forward one sexp. This function tries to correctly skip
 170   ;; template argument lists delimited by angle brackets.
 171   (c-skip-non-sexp-chars-forward)
 172   (if (and (eq (following-char) ?<)
 173            (condition-case nil
 174                (let ((start (point)))
 175                  (c-forward-template-arglist)
 176                  (if (or (not (eq (preceding-char) ?>))
 177                          (c-crosses-statement-barrier-p start (point)))
 178                      (progn (goto-char start) nil) t))
 179              (error nil)))
 180       nil
 181     (c-forward-sexp)))
 182
 183 (defun c-backward-extended-sexp ()
 184   ;; reverse of c-forward-extenden-sexp
 185   (c-skip-non-sexp-chars-backward)
 186   (if (and (eq (preceding-char) ?>)
 187            (condition-case nil
 188                (let ((start (point)))
 189                  (c-backward-template-arglist)
 190                  (if (or (not (eq (following-char) ?<))
 191                          (c-crosses-statement-barrier-p (point) start))
 192                      (progn (goto-char start) nil) t))
 193              (error nil)))
 194       nil
 195     (c-backward-sexp)))
 196
 197 ;; names
 198
 199 (defun c-forward-scoped-name ()
 200   ;; skip forward over a possibly fully scoped name at point
 201   ;; optionally containing template arglists. return list of scope
 202   ;; separators in the name
 203   (c-forward-syntactic-ws)
 204   (let (points)
 205     (while
 206         (progn
 207           (setq points (cons (point) points))
 208           (if (looking-at "::")
 209               (forward-char 2))
 210           (c-forward-syntactic-ws)
 211           (if (and (cond ((looking-at c-operator-word)
 212                           (goto-char (match-end 0)))
 213                          ((looking-at "~")
 214                           (forward-char 1)
 215                           (prog1
 216                               (c-at-symbol-p)
 217                             (c-forward-token-1)))
 218                          (t
 219                           (prog1
 220                               (c-at-symbol-p)
 221                             (c-forward-token-1))))
 222                    (eq (following-char) ?<))
 223               (progn
 224                 (c-forward-template-arglist)
 225                 (c-forward-syntactic-ws)))
 226           (looking-at "::")))
 227     (nreverse points)))
 228
 229 (defun c-backward-scoped-name ()
 230   ;; reverse of c-forward-scoped-name
 231   (c-backward-syntactic-ws)
 232   (while
 233       (progn
 234         (if (and (eq (preceding-char) ?>)
 235                  (not (save-excursion
 236                         (re-search-backward (concat c-operator-word "\\=") nil t))))
 237             (c-backward-template-arglist))
 238         (c-backward-syntactic-ws)
 239         (if (re-search-backward (concat c-operator-word "\\=") nil t)
 240             (goto-char (match-beginning 0))
 241           (c-backward-token-1)
 242           (if (and (c-at-symbol-p)
 243                    (eq (preceding-char) ?~))
 244               (forward-char -1)))
 245         (c-backward-syntactic-ws)
 246         (if (eq (preceding-char) ?:)
 247             (progn
 248               (forward-char -1)
 249               (if (eq (preceding-char) ?:)
 250                   (progn
 251                     (forward-char -1)
 252                     (c-backward-syntactic-ws)
 253                     t)
 254                 (forward-char 1)
 255                 nil)))))
 256   (c-forward-syntactic-ws))
 257
 258 (defun c-forward-balanced-token ()
 259   (c-forward-syntactic-ws)
 260   (cond ((or (c-at-symbol-p)
 261              (looking-at c-operator-word))
 262          (c-forward-scoped-name))
 263         ((memq (following-char) '(?\( ?{ ?<))
 264          (c-forward-extended-sexp))
 265         (t
 266          (c-forward-token-1))))
 267
 268 (defun c-backward-balanced-token ()
 269   (c-backward-syntactic-ws)
 270   (cond ((or (c-after-symbol-p)
 271              (re-search-backward (concat c-operator-word "\\=") nil t))
 272          (c-backward-scoped-name))
 273         ((memq (preceding-char) '(?\) ?} ?>))
 274          (c-backward-extended-sexp))
 275         (t
 276          (c-backward-token-1))))
 277
 278 ;; defun's
 279
 280 (defun c-move-to-start-of-defun (&optional limit)
 281   ;; move point to start of current defun. point is left at the start
 282   ;; of the function's name. Use (c-beginning-of-statement-1) to get
 283   ;; to the start of the declaration. returns point of body's opening
 284   ;; brace if defun found, otherwise nil. if LIMIT is non-nil, don't
 285   ;; move farther back than that.
 286   (let (new-point brace-point)
 287     (save-excursion
 288       (while
 289           (and (c-save-uplist -1)
 290                (or (not limit)
 291                    (> (point) limit))
 292                (not (setq new-point
 293                           (if (and (eq (following-char) ?{)
 294                                    (c-just-after-func-arglist-p))
 295                               (progn
 296                                 (setq brace-point (point))
 297                                 (c-beginning-of-statement-1)
 298                                 (while (and (< (point) brace-point)
 299                                             (not (eq (following-char) ?\()))
 300                                   (c-forward-extended-sexp)
 301                                   (c-forward-syntactic-ws))
 302                                 (if (eq (following-char) ?\()
 303                                     (progn
 304                                       (c-backward-syntactic-ws)
 305                                       (c-backward-scoped-name)
 306                                       (if (not (looking-at c-conditional-key))
 307                                           (point)))))))))))
 308     (if new-point
 309         (goto-char new-point))
 310     (and new-point brace-point)))
 311
 312 (defun c-beginning-of-defun-or-decl ()
 313   (if (c-in-literal)
 314       (goto-char (car (c-literal-limits))))
 315   (c-save-buffer-state ()
 316     (while (and (not (c-at-toplevel-p))
 317                 (c-save-uplist -1)))
 318     (c-move-to-start-of-defun)
 319     (let ((point (point))
 320           (flag (c-beginning-of-statement-1))
 321           beg)
 322       (cond ((eq flag 'label)
 323              (c-forward-label))
 324             ((eq flag 'previous)
 325              (goto-char point)))
 326     ;(setq beg (point))
 327     ;(c-end-of-statement)
 328     ;(if (> (point) point)
 329         ;(goto-char beg)
 330       ;(goto-char point))
 331       (c-forward-syntactic-ws))))
 332
 333 (defun c-forward-out-of-comment ()
 334   (while (memq (c-in-literal) '(c c++))
 335     (forward-char 1)))
 336
 337 (defun c-beginning-of-statement-2 ()
 338   ;; Move to the REAL beginning of the statement, ignoring all subexpressions
 339   (let ((point (point))
 340         (state (c-parse-state))
 341         (last (point)))
 342     (while (and state
 343                 (not (consp (car state)))
 344                 (progn
 345                   (goto-char (car state))
 346                   (looking-at "(")))
 347       (setq last (car state)
 348             state (cdr state)))
 349     (if (and state last
 350              (not (consp (car state))))
 351         (goto-char last))
 352     (c-beginning-of-statement-1)
 353     (while (and (< (point) point)
 354                 (or (c-crosses-statement-barrier-p (point) point)
 355                     (not (equal (c-parse-state) state))))
 356       (c-end-of-statement))
 357     (c-forward-syntactic-ws)
 358     (while (looking-at c-any-key)
 359       (if (looking-at c-blocking-key)
 360           (progn
 361             (c-forward-token-1)
 362             (c-forward-sexp))
 363         (c-forward-token-1))
 364       (c-forward-syntactic-ws))))
 365
 366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 367 ;; information on scopes (nesting levels)
 368
 369 (defun c-aggressive-search-uplist-for-classkey ()
 370   ;; like search-uplist-for-classkey but agressively retry at all
 371   ;; scoping levels until classkey found
 372   (save-excursion
 373     (let (state)
 374       (loop for state = (c-parse-state)
 375             while state
 376             thereis (loop for substate on state
 377                           thereis (c-save-buffer-state () (c-search-uplist-for-classkey substate)))
 378             for elt = (car (last state))
 379             do (goto-char (if (consp elt) (car elt) elt))))))
 380
 381 (defun c-search-uplist-for-scopekey (state)
 382   (let ((c-class-key c-scope-key))
 383     (c-search-uplist-for-classkey state)))
 384
 385 (defun c-aggressive-search-uplist-for-scopekey ()
 386   (let ((c-class-key c-scope-key))
 387     (c-aggressive-search-uplist-for-classkey)))
 388
 389 (defun c-save-uplist (arg)
 390   ;; like up-list but return nil on error
 391   (condition-case nil
 392       (progn
 393         (up-list arg)
 394         (point))
 395     (scan-error nil)))
 396
 397 (defun c-full-parse-state ()
 398   ;; return the complete parse-state from the beginning of buffer up
 399   ;; to (point)
 400   (save-excursion
 401     (let (state s elt)
 402       (while (setq s (c-parse-state)
 403                    elt (car (last s)))
 404         (goto-char (if (consp elt) (car elt) elt))
 405         (setq state (nconc state s)))
 406       state)))
 407
 408 (defun c-get-block-scope ()
 409   ;; return a list of scoping levels for point. Every scoping level is
 410   ;; identified by thier 'class for a class scope, or 'namespace for a
 411   ;; namespace scope For 'class and 'struct scopes, optional template
 412   ;; declarations are returned.
 413   (save-excursion
 414     (let (key element keys)
 415       (while (setq key (c-aggressive-search-uplist-for-scopekey))
 416         (goto-char (aref key 0))
 417         (setq element (vector nil
 418                               (aref key 0)
 419                               (aref key 1)
 420                               nil))
 421         (cond ((looking-at c-class-scope-key)
 422                (aset element 0 'class)
 423                (c-backward-syntactic-ws)
 424                (if (eq (preceding-char) ?>)
 425                    ;; this is a templated class/struct declaration
 426                    (save-excursion
 427                      (c-backward-template-arglist)
 428                      (c-backward-token-1)
 429                      (if (looking-at c-template-key)
 430                          (aset element 3 (point))))))
 431
 432                ((looking-at c-namespace-scope-key)
 433                 (aset element 0 'namespace)))
 434
 435         (if (aref element 0)
 436             (setq keys (cons element keys))))
 437       keys)))
 438
 439 (defun c-get-scope ()
 440   ;; This is like c-get-block-scope. Additionaly, if in a function
 441   ;; declaration or definition this will add a 'defun entry at the
 442   ;; end detailing the function information (and having an optional
 443   ;; template spec). The start of the function entry is the first char
 444   ;; of the functions typespec, the last char is just after the
 445   ;; closing paren of the function defn or decl.
 446   (let ((scope (c-get-block-scope)))
 447     (save-excursion
 448       (if (c-move-to-start-of-defun (and scope (aref (car (last scope)) 1)))
 449           (let ((element (vector 'defun (point) nil nil)))
 450             (c-forward-scoped-name)
 451             (aset element 2 (point))
 452             (c-beginning-of-statement-1)
 453             (if (looking-at c-template-key)
 454                 (aset element 3 (point)))
 455             (nconc scope (list element)))
 456         scope))))
 457
 458 (defun c-scope-name (p &optional strip)
 459   ;; return the name of the scope at P. if STRIP is non-nil, strip
 460   ;; that many elements from the name
 461   (save-excursion
 462     (goto-char p)
 463     (if (looking-at c-scope-key)
 464         (c-forward-token-1))
 465     (let ((points (c-forward-scoped-name)))
 466       (c-backward-syntactic-ws)
 467       (buffer-substring-no-properties (car points)
 468                                       (or (and strip (> strip 0)
 469                                                (or (and (<= strip (length points))
 470                                                         (car
 471                                                          (last
 472                                                           (nbutlast points
 473                                                                     (1- strip)))))
 474                                                    (car points)))
 475                                           (point))))))
 476
 477 (defun c-get-class-at-point ()
 478   ;; Return block scope for class at point.
 479   (save-excursion
 480     (c-forward-syntactic-ws)
 481     (while (looking-at c-template-key)
 482       (goto-char (match-end 0))
 483       (c-forward-extended-sexp)
 484       (c-forward-syntactic-ws))
 485     (and (looking-at c-class-scope-key)
 486          (search-forward "{" nil t))
 487     (last (c-get-block-scope))))
 488
 489 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 490 ;; template functions
 491
 492 (defun c-parse-template-declaration ()
 493   ;; parse the template declaration at point. return a list of
 494   ;; cons'es of argument def ranges.
 495   (save-excursion
 496     (if (looking-at c-template-key)
 497         (c-forward-token-1)
 498       (c-forward-syntactic-ws))
 499     (if (eq (following-char) ?<)
 500         (c-parse-arglist (point)
 501                          (progn (c-forward-template-arglist) (point))))))
 502
 503 (defun c-parse-arglist (start end)
 504   ;; parse arglist between START and END. The region between START end
 505   ;; END must include the delimiteres (parens or angle brackets) even
 506   ;; though theese delimiters are completely ignored
 507   (setq end (1- end))
 508   (let (args arg-start)
 509     (save-excursion
 510       (goto-char start)
 511       (while (and (not (eobp))
 512                   (< (point) end))
 513         (forward-char 1)
 514         (c-forward-syntactic-ws)
 515         (setq arg-start (point))
 516         (condition-case nil
 517             (while (progn
 518                      (c-forward-extended-sexp)
 519                      (and (not (eobp))
 520                           (< (point) end)
 521                           (not (eq (following-char) ?,)))))
 522           (scan-error nil))
 523         (save-excursion
 524           (c-backward-syntactic-ws)
 525               (if (> (point) end)
 526                   (goto-char end))
 527               (if (> (point) arg-start)
 528                   (setq args (cons (cons arg-start (point))
 529                                    args))))))
 530     (nreverse args)))
 531
 532 (defun c-move-to-template-argument (start end)
 533   ;; move to the template argument name within the template argument
 534   ;; between START and END
 535   (if (c-move-to-initializer start end)
 536       (forward-char -1)
 537     (goto-char end))
 538   (while (and (>= (point) start)
 539               (not (c-at-symbol-p))
 540               (not (bobp)))
 541     (c-backward-extended-sexp))
 542   (c-at-symbol-p))
 543
 544 (defun c-get-template-argument-name (start end)
 545   ;; get the argument name of the template argument defined between
 546   ;; START and END
 547   (save-excursion
 548     (c-move-to-template-argument start end)
 549     (buffer-substring-no-properties (point)
 550                                     (progn
 551                                       (c-forward-token-1)
 552                                       (c-backward-syntactic-ws)
 553                                       (point)))))
 554
 555 (defun c-get-template-prefix (args)
 556   ;; return the template prefix for the template declared with
 557   ;; arguments ARGS
 558   (concat "<"
 559           (mapconcat (function (lambda (x)
 560                                  (c-get-template-argument-name (car x) (cdr x))))
 561                      args
 562                      ",")
 563           ">"))
 564
 565 (defun c-is-template-id (p)
 566   ;; return t if scoped name at P is a template_id
 567   (save-excursion
 568     (goto-char p)
 569     (if (looking-at c-scope-key)
 570         (c-forward-token-1))
 571     (c-forward-scoped-name)
 572     (c-backward-syntactic-ws)
 573     (eq (preceding-char) ?>)))
 574
 575 (defun c-move-to-initializer (start end)
 576   ;; move point to the initializer for the argument declared between
 577   ;; START and END. return t if initializer found, otherwise nil. if
 578   ;; no initializer is found, point is left at START
 579   (goto-char start)
 580   (search-forward "=" end t))
 581
 582 (defun c-get-templates (scope)
 583   ;; return list of ranges of template specs in SCOPE
 584   (loop for level in scope
 585         if (aref level 3)
 586         collect (progn
 587                   (goto-char (aref level 3))
 588                   (c-forward-token-1)
 589                   (c-forward-template-arglist)
 590                   (c-backward-syntactic-ws)
 591                   (cons (aref level 3) (point)))))
 592
 593 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 594 ;; functions to parse defuns
 595
 596 (defun c-get-full-prefix (scope &optional strip)
 597   ;; return the full prefix for scope. if STRIP is non-nil, strip the
 598   ;; name of the current method, if any.
 599   (save-excursion
 600     (loop with last-p = (last scope)
 601           for elem-p on scope
 602           for elem = (car elem-p)
 603           for next = nil then t
 604           for last = (eq elem-p last-p)
 605           if (and last strip (eq (aref elem 0) 'defun))
 606             concat (let ((name (c-scope-name (aref elem 1) 1)))
 607                      (if (> (length name) 0)
 608                          (concat (if next "::" "") name) ""))
 609           else
 610             concat (concat (if next "::" "")
 611                            (c-scope-name (aref elem 1))
 612                            (if (and (aref elem 3)
 613                                     (not (c-is-template-id (aref elem 1))))
 614                                (progn
 615                                  (goto-char (aref elem 3))
 616                                  (c-get-template-prefix
 617                                   (c-parse-template-declaration)))
 618                              "")))))
 619
 620 (defun c-parse-defun ()
 621   ;; parse function definition or declaration at point. Returns a vector
 622   ;; of positions: [template type name arglist modifiers initializers body end]
 623   (save-excursion
 624     (c-beginning-of-defun-or-decl)
 625     (let (template type name arglist modifiers initializers body end)
 626       (if (looking-at c-template-key)
 627           (progn
 628             (setq template (point))
 629             (while (looking-at c-template-key)
 630               (c-forward-token-1)
 631               (c-forward-template-arglist)
 632               (c-forward-syntactic-ws))))
 633       (setq type (point))
 634       (while (and (not (or (eq (following-char) ?\()
 635                            (c-crosses-statement-barrier-p type (point))))
 636                   (let ((point (point)))
 637                     (> (progn (c-forward-balanced-token) (c-forward-syntactic-ws) (point)) point))))
 638       (save-excursion
 639         (c-backward-scoped-name)
 640         (setq name (point))
 641         (if (eq name type)
 642             (setq type nil)))
 643       (setq arglist (point))
 644       (c-forward-sexp)
 645       (c-forward-syntactic-ws)
 646       (if (not (memq (following-char) '(?{ ?\; ?:)))
 647           (progn
 648             (setq modifiers (point))
 649             (while (not (or (memq (following-char) '(?{ ?\; ?:))
 650                             (c-crosses-statement-barrier-p modifiers (point))
 651                             (eobp)))
 652               (c-forward-extended-sexp)
 653               (c-forward-syntactic-ws))))
 654       (if (eq (following-char) ?:)
 655           (progn
 656             (setq initializers (point))
 657             (while (not (or (memq (following-char) '(?{ ?\;))
 658                             (c-crosses-statement-barrier-p initializers (point))))
 659               (c-forward-extended-sexp)
 660               (c-forward-syntactic-ws))))
 661       (if (eq (following-char) ?{)
 662           (progn
 663             (setq body (point))
 664             (c-forward-sexp)))
 665       (setq end (point))
 666       (vector template type name arglist modifiers initializers body end))))
 667
 668 (defun c-get-defun-state ()
 669   ;; this extends c-parse-defun. it returns a vector containing the
 670   ;; following items:
 671   ;;   o templates: a list of cons'es each containing the range of a
 672   ;;             template specification
 673   ;;   o type: a cons containing the range for the return type
 674   ;;             specification of the function
 675   ;;   o name: a cons containing the range for the functions name
 676   ;;   o args: a list of cons'es, each containing the range of a
 677   ;;             function argument
 678   ;;   o modifiers: a cons containing the range of the modifiers
 679   ;;   o initializers: a list of cons'es each containing the range of
 680   ;;             an initializer
 681   ;;   o body: a cons containing the range for the body or nil, if no
 682   ;;             body
 683   ;;   o prototype: nil, if body is non-nil, otherwise the end of the
 684   ;;             prototype.
 685   ;;   o scope: the scope structure (as returned by c-get-block-scope)
 686   ;;             for this function
 687   (save-excursion
 688     (let ((defun (c-parse-defun))
 689           (scope (c-get-block-scope))
 690           templates type name args modifiers initializers body prototype)
 691       (setq templates (c-get-templates scope))
 692       (if (aref defun 0)
 693           (progn
 694             (goto-char (aref defun 0))
 695             (while (looking-at c-template-key)
 696               (setq templates (nconc templates
 697                                      (list (cons (point)
 698                                                  (progn
 699                                                    (c-forward-token-1)
 700                                                    (c-forward-template-arglist)
 701                                                    (c-backward-syntactic-ws)
 702                                                    (point))))))
 703               (c-forward-syntactic-ws))))
 704       (if (aref defun 1)
 705           (progn
 706             (goto-char (aref defun 2))
 707             (c-backward-syntactic-ws)
 708             (setq type (cons (aref defun 1) (point)))))
 709       (goto-char (aref defun 3))
 710       (c-backward-syntactic-ws)
 711       (setq name (cons (aref defun 2) (point)))
 712       (goto-char (aref defun 3))
 713       (let ((start (point)))
 714         (c-forward-sexp)
 715         (setq args (c-parse-arglist start (point))))
 716       (if (aref defun 4)
 717           (progn
 718             (goto-char (or (aref defun 5) (aref defun 6) (aref defun 7)))
 719             (c-backward-syntactic-ws)
 720             (setq modifiers (cons (aref defun 4) (point)))))
 721       (if (aref defun 5)
 722           (setq initializers (c-parse-arglist (aref defun 5)
 723                                               (1+ (or (aref defun 6)
 724                                                       (aref defun 7))))))
 725       (if (aref defun 6)
 726           (setq body (cons (aref defun 6) (aref defun 7))))
 727       (if (not body)
 728           (setq prototype (1+ (aref defun 7))))
 729       (vector templates type name args modifiers
 730               initializers body prototype scope))))
 731
 732 (defun c-defun-full-name (state)
 733   ;; return the full name of the defun in state
 734   (string-replace "[ \t\n\r]+" ""
 735                   (concat (c-get-full-prefix (aref state 8))
 736                           (if (aref state 8) "::" "")
 737                           (buffer-substring-no-properties (car (aref state 2))
 738                                                           (cdr (aref state 2))))
 739                   t))
 740
 741 (defun c-defun-short-name (state)
 742   ;; return the short name of the defun in state. This is the name of the defun
 743   ;; without template args or namespace/class prefix
 744   (let (p)
 745     (save-excursion
 746       (goto-char (cdr (aref state 2)))
 747       (if (and (eq (preceding-char) ?>)
 748                (not (save-excursion
 749                       (re-search-backward (concat c-operator-word "\\=") nil t))))
 750           (c-backward-template-arglist))
 751       (c-backward-syntactic-ws)
 752       (setq p (point))
 753       (if (re-search-backward (concat c-operator-word "\\=") nil t)
 754           (goto-char (match-beginning 0))
 755         (c-backward-token-1)
 756         (if (and (c-at-symbol-p)
 757                  (eq (preceding-char) ?~))
 758             (forward-char -1)))
 759       (buffer-substring-no-properties p (point)))))
 760
 761 (defun c-goto-beginning-of-defun (defun)
 762   (goto-char (or (car (aref defun 1))
 763                  (car (aref defun 2))))
 764   (loop for point = (point)
 765         for tmpl in (reverse (aref defun 0))
 766         do (c-backward-syntactic-ws)
 767         while (= (cdr tmpl) (point))
 768         do (progn
 769              (goto-char (car tmpl))
 770              (setq point (point)))
 771         finally do (goto-char point)))
 772
 773 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 774 ;; functions to parse classes
 775
 776 (defun c-parse-class (scope)
 777   ;; parse class at point. returns vector of positions: [template
 778   ;; class bases start ( members )] each member is a cons ( type
 779   ;; . start ) where type is one of 'typedef 'class 'friend 'variable
 780   ;; 'method or 'combo (combo is a combinded struct/class/union +
 781   ;; variable declaration)
 782   (save-excursion
 783     (let ((scope (car (last scope)))
 784           end template class bases start members)
 785       (if (not (eq (aref scope 0) 'class))
 786           nil
 787         (setq template (aref scope 3))
 788         (setq class (aref scope 1))
 789         (setq start (aref scope 2))
 790         (goto-char start)
 791         (while (and (< (skip-chars-backward "^:" class) 0)
 792                     (or (progn
 793                           (forward-char -1)
 794                           (and (eq (char-before) ?:) (progn (forward-char -1) t)))
 795                         (c-in-literal))))
 796         (if (eq (following-char) ?:)
 797             (progn
 798               (forward-char 1)
 799               (c-forward-syntactic-ws)
 800               (setq bases (point))))
 801         (goto-char start)
 802         (save-excursion
 803           (c-forward-sexp)
 804           (setq end (point)))
 805         (forward-char 1)
 806         (while (progn (c-end-of-statement)
 807                       (< (point) end))
 808           (let ((bc (char-before))
 809                 (this (point)))
 810             (if (eq bc ?{)
 811                 (save-excursion
 812                   (forward-char -1)
 813                   (c-forward-sexp)
 814                   (setq this (point))))
 815             (if (or (eq bc ?\;) (eq bc ?{))
 816                 (progn
 817                   (forward-char -1)
 818                   (if (re-search-backward "=\\s-*0\\s-*\\=" start t)
 819                       (goto-char (match-beginning 0)))
 820                   (if (c-just-after-func-arglist-p)
 821                       ;; OK. It's a method (defn or decl)
 822                       (progn
 823                         (c-beginning-of-statement-1)
 824                         (setq members (cons (cons 'method (point))
 825                                             members)))
 826                     (if (eq bc ?{)
 827                         ;; this should be a class or struct decl. Maybe
 828                         ;; a variable.
 829                         (let (pos decl beg)
 830                           (setq pos (point))
 831                           (c-beginning-of-statement-1)
 832                           (setq beg (point))
 833                           (if (looking-at c-class-scope-key)
 834                               ;; it really IS a class/struct/union
 835                               (progn
 836                                 (goto-char (match-end 0))
 837                                 (c-forward-syntactic-ws)
 838                                 (setq decl (looking-at "[a-zA-Z_]"))
 839                                 (goto-char pos)
 840                                 (c-forward-sexp)
 841                                 (c-forward-syntactic-ws)
 842                                 (if (eq (following-char) ?\;)
 843                                     ;; no variable defn
 844                                     (if decl
 845                                         (setq members (cons (cons 'class beg)
 846                                                             members)))
 847                                   (save-excursion
 848                                     (goto-char this)
 849                                     (c-end-of-statement)
 850                                     (setq this (point)))
 851                                   (setq members (cons (cons (if decl 'combo 'variable)
 852                                                             beg)
 853                                                       members))))))
 854                       ;; then it's a variable decl or typedef or friend
 855                       (c-beginning-of-statement-1)
 856                       (cond ((looking-at c-typedef-key)
 857                              (setq members (cons (cons 'typedef (point)) members)))
 858                             ((looking-at c-friend-key)
 859                              (setq members (cons (cons 'friend (point)) members)))
 860                             (t
 861                              (setq members (cons (cons 'variable (point)) members))))
 862                       ))))
 863             (goto-char this)))
 864         (vector template class bases start (nreverse members))))))
 865
 866 (defun c-current-access-level ()
 867   ;; returm current access level: 'public, 'protected or 'private
 868   (save-excursion
 869     (let ((scope (car (last (c-get-block-scope)))))
 870       (while (and (re-search-backward c-access-key (aref scope 2) t)
 871                   (or (c-in-literal)
 872                       (not (eq (aref (car (c-get-block-scope)) 1) (aref scope 1))))))
 873       (loop for (re . sym) in c-access-keys
 874             if (looking-at re)
 875               return sym
 876             finally return (progn
 877                              (goto-char (aref scope 1))
 878                              (if (looking-at c-struct-scope-key)
 879                                  'public
 880                                'private))))))
 881
 882 (defun c-get-variable-members (class)
 883   ;; return list of names of all variables of CLASS
 884   (save-excursion
 885     (loop for (type . pos) in (aref class 4)
 886           for end = (progn (goto-char pos) (c-end-of-statement) (1- (point)))
 887           if (or (eq type 'variable) (eq type 'combo))
 888             collect (c-get-template-argument-name pos end))))
 889
 890 (defun c-get-variable-members-with-type (class)
 891   ;; return list of conses of (name . type) of all variables of CLASS
 892   (save-excursion
 893     (loop for (type . pos) in (aref class 4)
 894           for end = (progn (goto-char pos) (c-end-of-statement) (1- (point)))
 895           if (eq type 'variable)
 896             collect (c-get-variable-with-type pos end))))
 897
 898 (defun c-get-variable-with-type (start end)
 899   (c-move-to-template-argument start end)
 900   (let ((arg (save-excursion
 901                (buffer-substring-no-properties (point)
 902                                                (progn
 903                                                  (c-forward-token-1)
 904                                                  (c-backward-syntactic-ws)
 905                                                  (point))))))
 906     (c-backward-syntactic-ws)
 907     (cons arg (buffer-substring-no-properties start (point)))))
 908
 909 (defun c-get-base-classes (class)
 910   ;; return list of base class names (including template specs)
 911   (and (aref class 2)
 912        (save-excursion
 913          (goto-char (aref class 2))
 914          (loop while (< (point) (aref class 3))
 915                do (progn (c-forward-syntactic-ws)
 916                          (while (looking-at c-inheritance-spec-key)
 917                            (c-forward-token-1)
 918                            (c-forward-syntactic-ws)))
 919                for start = (point)
 920                do (progn (c-forward-scoped-name) (c-backward-syntactic-ws))
 921                collect (buffer-substring-no-properties start (point))
 922                do (progn
 923                     (while (and (> (skip-chars-forward "^," (aref class 3)) 0)
 924                                 (c-in-literal))
 925                       (forward-char 1))
 926                     (forward-char 1))))))
 927
 928 (provide 'cc-engine-2)
 929
 930 \f
 931 ;;; Local Variables:
 932 ;;; elisp-project-autoload-file-name: "cc-autoload.el"
 933 ;;; End: