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   (while (and (not (c-at-toplevel-p))
 316               (c-save-uplist -1)))
 317   (c-move-to-start-of-defun)
 318   (let ((point (point))
 319         (flag (c-beginning-of-statement-1))
 320         beg)
 321     (cond ((eq flag 'label)
 322            (c-forward-label))
 323           ((eq flag 'previous)
 324            (goto-char point)))
 325     ;(setq beg (point))
 326     ;(c-end-of-statement)
 327     ;(if (> (point) point)
 328         ;(goto-char beg)
 329       ;(goto-char point))
 330     (c-forward-syntactic-ws)))
 331
 332 (defun c-forward-out-of-comment ()
 333   (while (memq (c-in-literal) '(c c++))
 334     (forward-char 1)))
 335
 336 (defun c-beginning-of-statement-2 ()
 337   ;; Move to the REAL beginning of the statement, ignoring all subexpressions
 338   (let ((point (point))
 339         (state (c-parse-state))
 340         (last (point)))
 341     (while (and state
 342                 (not (consp (car state)))
 343                 (progn
 344                   (goto-char (car state))
 345                   (looking-at "(")))
 346       (setq last (car state)
 347             state (cdr state)))
 348     (if (and state last
 349              (not (consp (car state))))
 350         (goto-char last))
 351     (c-beginning-of-statement-1)
 352     (while (and (< (point) point)
 353                 (or (c-crosses-statement-barrier-p (point) point)
 354                     (not (equal (c-parse-state) state))))
 355       (c-end-of-statement))
 356     (c-forward-syntactic-ws)
 357     (while (looking-at c-any-key)
 358       (if (looking-at c-blocking-key)
 359           (progn
 360             (c-forward-token-1)
 361             (c-forward-sexp))
 362         (c-forward-token-1))
 363       (c-forward-syntactic-ws))))
 364
 365 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 366 ;; information on scopes (nesting levels)
 367
 368 (defun c-aggressive-search-uplist-for-classkey ()
 369   ;; like search-uplist-for-classkey but agressively retry at all
 370   ;; scoping levels until classkey found
 371   (save-excursion
 372     (let (state)
 373       (loop for state = (c-parse-state)
 374             while state
 375             thereis (loop for substate on state
 376                           thereis (c-search-uplist-for-classkey substate))
 377             for elt = (car (last state))
 378             do (goto-char (if (consp elt) (car elt) elt))))))
 379
 380 (defun c-search-uplist-for-scopekey (state)
 381   (let ((c-class-key c-scope-key))
 382     (c-search-uplist-for-classkey state)))
 383
 384 (defun c-aggressive-search-uplist-for-scopekey ()
 385   (let ((c-class-key c-scope-key))
 386     (c-aggressive-search-uplist-for-classkey)))
 387
 388 (defun c-save-uplist (arg)
 389   ;; like up-list but return nil on error
 390   (condition-case nil
 391       (progn
 392         (up-list arg)
 393         (point))
 394     (scan-error nil)))
 395
 396 (defun c-full-parse-state ()
 397   ;; return the complete parse-state from the beginning of buffer up
 398   ;; to (point)
 399   (save-excursion
 400     (let (state s elt)
 401       (while (setq s (c-parse-state)
 402                    elt (car (last s)))
 403         (goto-char (if (consp elt) (car elt) elt))
 404         (setq state (nconc state s)))
 405       state)))
 406
 407 (defun c-get-block-scope ()
 408   ;; return a list of scoping levels for point. Every scoping level is
 409   ;; identified by thier 'class for a class scope, or 'namespace for a
 410   ;; namespace scope For 'class and 'struct scopes, optional template
 411   ;; declarations are returned.
 412   (save-excursion
 413     (let (key element keys)
 414       (while (setq key (c-aggressive-search-uplist-for-scopekey))
 415         (goto-char (aref key 0))
 416         (setq element (vector nil
 417                               (aref key 0)
 418                               (aref key 1)
 419                               nil))
 420         (cond ((looking-at c-class-scope-key)
 421                (aset element 0 'class)
 422                (c-backward-syntactic-ws)
 423                (if (eq (preceding-char) ?>)
 424                    ;; this is a templated class/struct declaration
 425                    (save-excursion
 426                      (c-backward-template-arglist)
 427                      (c-backward-token-1)
 428                      (if (looking-at c-template-key)
 429                          (aset element 3 (point))))))
 430
 431                ((looking-at c-namespace-scope-key)
 432                 (aset element 0 'namespace)))
 433
 434         (if (aref element 0)
 435             (setq keys (cons element keys))))
 436       keys)))
 437
 438 (defun c-get-scope ()
 439   ;; This is like c-get-block-scope. Additionaly, if in a function
 440   ;; declaration or definition this will add a 'defun entry at the
 441   ;; end detailing the function information (and having an optional
 442   ;; template spec). The start of the function entry is the first char
 443   ;; of the functions typespec, the last char is just after the
 444   ;; closing paren of the function defn or decl.
 445   (let ((scope (c-get-block-scope)))
 446     (save-excursion
 447       (if (c-move-to-start-of-defun (and scope (aref (car (last scope)) 1)))
 448           (let ((element (vector 'defun (point) nil nil)))
 449             (c-forward-scoped-name)
 450             (aset element 2 (point))
 451             (c-beginning-of-statement-1)
 452             (if (looking-at c-template-key)
 453                 (aset element 3 (point)))
 454             (nconc scope (list element)))
 455         scope))))
 456
 457 (defun c-scope-name (p &optional strip)
 458   ;; return the name of the scope at P. if STRIP is non-nil, strip
 459   ;; that many elements from the name
 460   (save-excursion
 461     (goto-char p)
 462     (if (looking-at c-scope-key)
 463         (c-forward-token-1))
 464     (let ((points (c-forward-scoped-name)))
 465       (c-backward-syntactic-ws)
 466       (buffer-substring-no-properties (car points)
 467                                       (or (and strip (> strip 0)
 468                                                (or (and (<= strip (length points))
 469                                                         (car
 470                                                          (last
 471                                                           (nbutlast points
 472                                                                     (1- strip)))))
 473                                                    (car points)))
 474                                           (point))))))
 475
 476 (defun c-get-class-at-point ()
 477   ;; Return block scope for class at point.
 478   (save-excursion
 479     (c-forward-syntactic-ws)
 480     (while (looking-at c-template-key)
 481       (goto-char (match-end 0))
 482       (c-forward-extended-sexp)
 483       (c-forward-syntactic-ws))
 484     (and (looking-at c-class-scope-key)
 485          (search-forward "{" nil t))
 486     (last (c-get-block-scope))))
 487
 488 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 489 ;; template functions
 490
 491 (defun c-parse-template-declaration ()
 492   ;; parse the template declaration at point. return a list of
 493   ;; cons'es of argument def ranges.
 494   (save-excursion
 495     (if (looking-at c-template-key)
 496         (c-forward-token-1)
 497       (c-forward-syntactic-ws))
 498     (if (eq (following-char) ?<)
 499         (c-parse-arglist (point)
 500                          (progn (c-forward-template-arglist) (point))))))
 501
 502 (defun c-parse-arglist (start end)
 503   ;; parse arglist between START and END. The region between START end
 504   ;; END must include the delimiteres (parens or angle brackets) even
 505   ;; though theese delimiters are completely ignored
 506   (setq end (1- end))
 507   (let (args arg-start)
 508     (save-excursion
 509       (goto-char start)
 510       (while (and (not (eobp))
 511                   (< (point) end))
 512         (forward-char 1)
 513         (c-forward-syntactic-ws)
 514         (setq arg-start (point))
 515         (condition-case nil
 516             (while (progn
 517                      (c-forward-extended-sexp)
 518                      (and (not (eobp))
 519                           (< (point) end)
 520                           (not (eq (following-char) ?,)))))
 521           (scan-error nil))
 522         (save-excursion
 523           (c-backward-syntactic-ws)
 524               (if (> (point) end)
 525                   (goto-char end))
 526               (if (> (point) arg-start)
 527                   (setq args (cons (cons arg-start (point))
 528                                    args))))))
 529     (nreverse args)))
 530
 531 (defun c-move-to-template-argument (start end)
 532   ;; move to the template argument name within the template argument
 533   ;; between START and END
 534   (if (c-move-to-initializer start end)
 535       (forward-char -1)
 536     (goto-char end))
 537   (while (and (>= (point) start)
 538               (not (c-at-symbol-p))
 539               (not (bobp)))
 540     (c-backward-extended-sexp))
 541   (c-at-symbol-p))
 542
 543 (defun c-get-template-argument-name (start end)
 544   ;; get the argument name of the template argument defined between
 545   ;; START and END
 546   (save-excursion
 547     (c-move-to-template-argument start end)
 548     (buffer-substring-no-properties (point)
 549                                     (progn
 550                                       (c-forward-token-1)
 551                                       (c-backward-syntactic-ws)
 552                                       (point)))))
 553
 554 (defun c-get-template-prefix (args)
 555   ;; return the template prefix for the template declared with
 556   ;; arguments ARGS
 557   (concat "<"
 558           (mapconcat (function (lambda (x)
 559                                  (c-get-template-argument-name (car x) (cdr x))))
 560                      args
 561                      ",")
 562           ">"))
 563
 564 (defun c-is-template-id (p)
 565   ;; return t if scoped name at P is a template_id
 566   (save-excursion
 567     (goto-char p)
 568     (if (looking-at c-scope-key)
 569         (c-forward-token-1))
 570     (c-forward-scoped-name)
 571     (c-backward-syntactic-ws)
 572     (eq (preceding-char) ?>)))
 573
 574 (defun c-move-to-initializer (start end)
 575   ;; move point to the initializer for the argument declared between
 576   ;; START and END. return t if initializer found, otherwise nil. if
 577   ;; no initializer is found, point is left at START
 578   (goto-char start)
 579   (search-forward "=" end t))
 580
 581 (defun c-get-templates (scope)
 582   ;; return list of ranges of template specs in SCOPE
 583   (loop for level in scope
 584         if (aref level 3)
 585         collect (progn
 586                   (goto-char (aref level 3))
 587                   (c-forward-token-1)
 588                   (c-forward-template-arglist)
 589                   (c-backward-syntactic-ws)
 590                   (cons (aref level 3) (point)))))
 591
 592 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 593 ;; functions to parse defuns
 594
 595 (defun c-get-full-prefix (scope &optional strip)
 596   ;; return the full prefix for scope. if STRIP is non-nil, strip the
 597   ;; name of the current method, if any.
 598   (save-excursion
 599     (loop with last-p = (last scope)
 600           for elem-p on scope
 601           for elem = (car elem-p)
 602           for next = nil then t
 603           for last = (eq elem-p last-p)
 604           if (and last strip (eq (aref elem 0) 'defun))
 605             concat (let ((name (c-scope-name (aref elem 1) 1)))
 606                      (if (> (length name) 0)
 607                          (concat (if next "::" "") name) ""))
 608           else
 609             concat (concat (if next "::" "")
 610                            (c-scope-name (aref elem 1))
 611                            (if (and (aref elem 3)
 612                                     (not (c-is-template-id (aref elem 1))))
 613                                (progn
 614                                  (goto-char (aref elem 3))
 615                                  (c-get-template-prefix
 616                                   (c-parse-template-declaration)))
 617                              "")))))
 618
 619 (defun c-parse-defun ()
 620   ;; parse function definition or declaration at point. Returns a vector
 621   ;; of positions: [template type name arglist modifiers initializers body end]
 622   (save-excursion
 623     (c-beginning-of-defun-or-decl)
 624     (let (template type name arglist modifiers initializers body end)
 625       (if (looking-at c-template-key)
 626           (progn
 627             (setq template (point))
 628             (while (looking-at c-template-key)
 629               (c-forward-token-1)
 630               (c-forward-template-arglist)
 631               (c-forward-syntactic-ws))))
 632       (setq type (point))
 633       (while (and (not (or (eq (following-char) ?\()
 634                            (c-crosses-statement-barrier-p type (point))))
 635                   (let ((point (point)))
 636                     (> (progn (c-forward-balanced-token) (c-forward-syntactic-ws) (point)) point))))
 637       (save-excursion
 638         (c-backward-scoped-name)
 639         (setq name (point))
 640         (if (eq name type)
 641             (setq type nil)))
 642       (setq arglist (point))
 643       (c-forward-sexp)
 644       (c-forward-syntactic-ws)
 645       (if (not (memq (following-char) '(?{ ?\; ?:)))
 646           (progn
 647             (setq modifiers (point))
 648             (while (not (or (memq (following-char) '(?{ ?\; ?:))
 649                             (c-crosses-statement-barrier-p modifiers (point))
 650                             (eobp)))
 651               (c-forward-extended-sexp)
 652               (c-forward-syntactic-ws))))
 653       (if (eq (following-char) ?:)
 654           (progn
 655             (setq initializers (point))
 656             (while (not (or (memq (following-char) '(?{ ?\;))
 657                             (c-crosses-statement-barrier-p initializers (point))))
 658               (c-forward-extended-sexp)
 659               (c-forward-syntactic-ws))))
 660       (if (eq (following-char) ?{)
 661           (progn
 662             (setq body (point))
 663             (c-forward-sexp)))
 664       (setq end (point))
 665       (vector template type name arglist modifiers initializers body end))))
 666
 667 (defun c-get-defun-state ()
 668   ;; this extends c-parse-defun. it returns a vector containing the
 669   ;; following items:
 670   ;;   o templates: a list of cons'es each containing the range of a
 671   ;;             template specification
 672   ;;   o type: a cons containing the range for the return type
 673   ;;             specification of the function
 674   ;;   o name: a cons containing the range for the functions name
 675   ;;   o args: a list of cons'es, each containing the range of a
 676   ;;             function argument
 677   ;;   o modifiers: a cons containing the range of the modifiers
 678   ;;   o initializers: a list of cons'es each containing the range of
 679   ;;             an initializer
 680   ;;   o body: a cons containing the range for the body or nil, if no
 681   ;;             body
 682   ;;   o prototype: nil, if body is non-nil, otherwise the end of the
 683   ;;             prototype.
 684   ;;   o scope: the scope structure (as returned by c-get-block-scope)
 685   ;;             for this function
 686   (save-excursion
 687     (let ((defun (c-parse-defun))
 688           (scope (c-get-block-scope))
 689           templates type name args modifiers initializers body prototype)
 690       (setq templates (c-get-templates scope))
 691       (if (aref defun 0)
 692           (progn
 693             (goto-char (aref defun 0))
 694             (while (looking-at c-template-key)
 695               (setq templates (nconc templates
 696                                      (list (cons (point)
 697                                                  (progn
 698                                                    (c-forward-token-1)
 699                                                    (c-forward-template-arglist)
 700                                                    (c-backward-syntactic-ws)
 701                                                    (point))))))
 702               (c-forward-syntactic-ws))))
 703       (if (aref defun 1)
 704           (progn
 705             (goto-char (aref defun 2))
 706             (c-backward-syntactic-ws)
 707             (setq type (cons (aref defun 1) (point)))))
 708       (goto-char (aref defun 3))
 709       (c-backward-syntactic-ws)
 710       (setq name (cons (aref defun 2) (point)))
 711       (goto-char (aref defun 3))
 712       (let ((start (point)))
 713         (c-forward-sexp)
 714         (setq args (c-parse-arglist start (point))))
 715       (if (aref defun 4)
 716           (progn
 717             (goto-char (or (aref defun 5) (aref defun 6) (aref defun 7)))
 718             (c-backward-syntactic-ws)
 719             (setq modifiers (cons (aref defun 4) (point)))))
 720       (if (aref defun 5)
 721           (setq initializers (c-parse-arglist (aref defun 5)
 722                                               (1+ (or (aref defun 6)
 723                                                       (aref defun 7))))))
 724       (if (aref defun 6)
 725           (setq body (cons (aref defun 6) (aref defun 7))))
 726       (if (not body)
 727           (setq prototype (1+ (aref defun 7))))
 728       (vector templates type name args modifiers
 729               initializers body prototype scope))))
 730
 731 (defun c-defun-full-name (state)
 732   ;; return the full name of the defun in state
 733   (string-replace "[ \t\n\r]+" ""
 734                   (concat (c-get-full-prefix (aref state 8))
 735                           (if (aref state 8) "::" "")
 736                           (buffer-substring-no-properties (car (aref state 2))
 737                                                           (cdr (aref state 2))))
 738                   t))
 739
 740 (defun c-defun-short-name (state)
 741   ;; return the short name of the defun in state. This is the name of the defun
 742   ;; without template args or namespace/class prefix
 743   (let (p)
 744     (save-excursion
 745       (goto-char (cdr (aref state 2)))
 746       (if (and (eq (preceding-char) ?>)
 747                (not (save-excursion
 748                       (re-search-backward (concat c-operator-word "\\=") nil t))))
 749           (c-backward-template-arglist))
 750       (c-backward-syntactic-ws)
 751       (setq p (point))
 752       (if (re-search-backward (concat c-operator-word "\\=") nil t)
 753           (goto-char (match-beginning 0))
 754         (c-backward-token-1)
 755         (if (and (c-at-symbol-p)
 756                  (eq (preceding-char) ?~))
 757             (forward-char -1)))
 758       (buffer-substring-no-properties p (point)))))
 759
 760 (defun c-goto-beginning-of-defun (defun)
 761   (goto-char (or (car (aref defun 1))
 762                  (car (aref defun 2))))
 763   (loop for point = (point)
 764         for tmpl in (reverse (aref defun 0))
 765         do (c-backward-syntactic-ws)
 766         while (= (cdr tmpl) (point))
 767         do (progn
 768              (goto-char (car tmpl))
 769              (setq point (point)))
 770         finally do (goto-char point)))
 771
 772 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 773 ;; functions to parse classes
 774
 775 (defun c-parse-class (scope)
 776   ;; parse class at point. returns vector of positions: [template
 777   ;; class bases start ( members )] each member is a cons ( type
 778   ;; . start ) where type is one of 'typedef 'class 'friend 'variable
 779   ;; 'method or 'combo (combo is a combinded struct/class/union +
 780   ;; variable declaration)
 781   (save-excursion
 782     (let ((scope (car (last scope)))
 783           end template class bases start members)
 784       (if (not (eq (aref scope 0) 'class))
 785           nil
 786         (setq template (aref scope 3))
 787         (setq class (aref scope 1))
 788         (setq start (aref scope 2))
 789         (goto-char start)
 790         (while (and (< (skip-chars-backward "^:" class) 0)
 791                     (or (progn
 792                           (forward-char -1)
 793                           (and (eq (char-before) ?:) (progn (forward-char -1) t)))
 794                         (c-in-literal))))
 795         (if (eq (following-char) ?:)
 796             (progn
 797               (forward-char 1)
 798               (c-forward-syntactic-ws)
 799               (setq bases (point))))
 800         (goto-char start)
 801         (save-excursion
 802           (c-forward-sexp)
 803           (setq end (point)))
 804         (forward-char 1)
 805         (while (progn (c-end-of-statement)
 806                       (< (point) end))
 807           (let ((bc (char-before))
 808                 (this (point)))
 809             (if (eq bc ?{)
 810                 (save-excursion
 811                   (forward-char -1)
 812                   (c-forward-sexp)
 813                   (setq this (point))))
 814             (if (or (eq bc ?\;) (eq bc ?{))
 815                 (progn
 816                   (forward-char -1)
 817                   (if (re-search-backward "=\\s-*0\\s-*\\=" start t)
 818                       (goto-char (match-beginning 0)))
 819                   (if (c-just-after-func-arglist-p)
 820                       ;; OK. It's a method (defn or decl)
 821                       (progn
 822                         (c-beginning-of-statement-1)
 823                         (setq members (cons (cons 'method (point))
 824                                             members)))
 825                     (if (eq bc ?{)
 826                         ;; this should be a class or struct decl. Maybe
 827                         ;; a variable.
 828                         (let (pos decl beg)
 829                           (setq pos (point))
 830                           (c-beginning-of-statement-1)
 831                           (setq beg (point))
 832                           (if (looking-at c-class-scope-key)
 833                               ;; it really IS a class/struct/union
 834                               (progn
 835                                 (goto-char (match-end 0))
 836                                 (c-forward-syntactic-ws)
 837                                 (setq decl (looking-at "[a-zA-Z_]"))
 838                                 (goto-char pos)
 839                                 (c-forward-sexp)
 840                                 (c-forward-syntactic-ws)
 841                                 (if (eq (following-char) ?\;)
 842                                     ;; no variable defn
 843                                     (if decl
 844                                         (setq members (cons (cons 'class beg)
 845                                                             members)))
 846                                   (save-excursion
 847                                     (goto-char this)
 848                                     (c-end-of-statement)
 849                                     (setq this (point)))
 850                                   (setq members (cons (cons (if decl 'combo 'variable)
 851                                                             beg)
 852                                                       members))))))
 853                       ;; then it's a variable decl or typedef or friend
 854                       (c-beginning-of-statement-1)
 855                       (cond ((looking-at c-typedef-key)
 856                              (setq members (cons (cons 'typedef (point)) members)))
 857                             ((looking-at c-friend-key)
 858                              (setq members (cons (cons 'friend (point)) members)))
 859                             (t
 860                              (setq members (cons (cons 'variable (point)) members))))
 861                       ))))
 862             (goto-char this)))
 863         (vector template class bases start (nreverse members))))))
 864
 865 (defun c-current-access-level ()
 866   ;; returm current access level: 'public, 'protected or 'private
 867   (save-excursion
 868     (let ((scope (car (last (c-get-block-scope)))))
 869       (while (and (re-search-backward c-access-key (aref scope 2) t)
 870                   (or (c-in-literal)
 871                       (not (eq (aref (car (c-get-block-scope)) 1) (aref scope 1))))))
 872       (loop for (re . sym) in c-access-keys
 873             if (looking-at re)
 874               return sym
 875             finally return (progn
 876                              (goto-char (aref scope 1))
 877                              (if (looking-at c-struct-scope-key)
 878                                  'public
 879                                'private))))))
 880
 881 (defun c-get-variable-members (class)
 882   ;; return list of names of all variables of CLASS
 883   (save-excursion
 884     (loop for (type . pos) in (aref class 4)
 885           for end = (progn (goto-char pos) (c-end-of-statement) (1- (point)))
 886           if (or (eq type 'variable) (eq type 'combo))
 887             collect (c-get-template-argument-name pos end))))
 888
 889 (defun c-get-variable-members-with-type (class)
 890   ;; return list of conses of (name . type) of all variables of CLASS
 891   (save-excursion
 892     (loop for (type . pos) in (aref class 4)
 893           for end = (progn (goto-char pos) (c-end-of-statement) (1- (point)))
 894           if (eq type 'variable)
 895             collect (c-get-variable-with-type pos end))))
 896
 897 (defun c-get-variable-with-type (start end)
 898   (c-move-to-template-argument start end)
 899   (let ((arg (save-excursion
 900                (buffer-substring-no-properties (point)
 901                                                (progn
 902                                                  (c-forward-token-1)
 903                                                  (c-backward-syntactic-ws)
 904                                                  (point))))))
 905     (c-backward-syntactic-ws)
 906     (cons arg (buffer-substring-no-properties start (point)))))
 907
 908 (defun c-get-base-classes (class)
 909   ;; return list of base class names (including template specs)
 910   (and (aref class 2)
 911        (save-excursion
 912          (goto-char (aref class 2))
 913          (loop while (< (point) (aref class 3))
 914                do (progn (c-forward-syntactic-ws)
 915                          (while (looking-at c-inheritance-spec-key)
 916                            (c-forward-token-1)
 917                            (c-forward-syntactic-ws)))
 918                for start = (point)
 919                do (progn (c-forward-scoped-name) (c-backward-syntactic-ws))
 920                collect (buffer-substring-no-properties start (point))
 921                do (progn
 922                     (while (and (> (skip-chars-forward "^," (aref class 3)) 0)
 923                                 (c-in-literal))
 924                       (forward-char 1))
 925                     (forward-char 1))))))
 926
 927 (provide 'cc-engine-2)
 928
 929 \f
 930 ;;; Local Variables:
 931 ;;; elisp-project-autoload-file-name: "cc-autoload.el"
 932 ;;; End: