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