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