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