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