comparison lisp/oobr/br-c++.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: br-c++.el
4 ;; SUMMARY: Support routines for C++ inheritance browsing.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: c, oop, tools
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola Inc.
10 ;;
11 ;; ORIG-DATE: 7-Dec-89
12 ;; LAST-MOD: 21-Sep-95 at 12:28:56 by Bob Weiner
13 ;;
14 ;; Copyright (C) 1989-1995 Free Software Foundation, Inc.
15 ;; See the file BR-COPY for license information.
16 ;;
17 ;; This file is part of the OO-Browser.
18 ;;
19 ;; DESCRIPTION:
20 ;;
21 ;; Properly supports C++ multiple inheritance.
22 ;;
23 ;; See 'c++-class-def-regexp' for regular expression that matches class
24 ;; definitions. You may want to modify it to your own tastes, for
25 ;; example if you do not want to consider 'struct' definitions as classes
26 ;; even though grammatically, they are.
27 ;;
28 ;; DESCRIP-END.
29
30 ;;; ************************************************************************
31 ;;; Other required Elisp libraries
32 ;;; ************************************************************************
33
34 (mapcar 'require '(br-lib hypb br-c-ft))
35
36 ;;; ************************************************************************
37 ;;; User visible variables
38 ;;; ************************************************************************
39
40 (defvar c++-class-keyword
41 "\\(class\\|struct\\|union\\)[ \t\n]+"
42 "*Keyword regexp preceding a C++ class declaration or definition.")
43
44 (defvar c++-lib-search-dirs nil
45 "List of directories below which C++ Library source files are found.
46 Subdirectories of Library source are also searched. A Library is a stable
47 group of classes.")
48
49 (defvar c++-sys-search-dirs nil
50 "List of directories below which C++ System source files are found.
51 Subdirectories of System source are also searched. A System class is one
52 that is not yet reusable and is likely to change before release.")
53
54
55 (defconst c++-narrow-view-to-class nil
56 "*Non-nil means narrow buffer to just the matching class definition when displayed.")
57
58 ;;; ************************************************************************
59 ;;; Internal functions
60 ;;; ************************************************************************
61
62 (defun c++-get-classes-from-source (filename &optional skip-tags
63 skip-tags-cleanup)
64 "Scans FILENAME and returns cons of class list with parents-class alist.
65 Handles multiple inheritance. Assumes file existence and readability have
66 already been checked.
67 With optional SKIP-TAGS non-nil, does not compute and store lookup tags
68 for member definitions. If SKIP-TAGS is nil, normally a cleanup
69 function is called after scanning the members. SKIP-TAGS-CLEANUP
70 non-nil suppresses this action."
71 (let ((no-kill (get-file-buffer filename))
72 class-name-end classes class has-parents open-brace-point
73 parents parent-cons signatures)
74 (if no-kill
75 (set-buffer no-kill)
76 (funcall br-view-file-function filename))
77 (save-excursion
78 (save-restriction
79 (widen)
80 (goto-char (point-min))
81 (or skip-tags
82 (progn (setq signatures (c++-scan-features))
83 (goto-char (point-min))))
84 (while (re-search-forward c++-class-def-regexp nil t)
85 (setq has-parents
86 (= ?: (char-after
87 (match-beginning c++-class-def-derived-grpn)))
88 class-name-end (match-end c++-class-def-name-grpn)
89 ;;
90 ;; Now since we've saved all the match expressions we need
91 ;; from our last regexp match, we can call functions which
92 ;; change the match data below here.
93 class (c++-normalize-class-match t)
94 parent-cons (cons (if has-parents
95 ;; Return parents as a list.
96 (c++-scan-parents))
97 class))
98 ;; Ensure class name not found within a comment
99 (if (c-within-comment-p)
100 (progn (search-forward "*/" nil t)
101 (setq class nil parent-cons nil))
102 (setq classes (cons class classes)
103 parents (cons parent-cons parents))
104 (or skip-tags
105 ;; Scan members defined within class
106 (progn (goto-char class-name-end)
107 (if (search-forward "{" nil t)
108 (progn (setq open-brace-point (point))
109 (backward-char)
110 ;; Move to class close brace but ignore
111 ;; any error if braces are unbalanced.
112 ;; Let the compiler tell the user about
113 ;; this.
114 (if (condition-case ()
115 (progn (forward-sexp) t)
116 (error nil))
117 (setq signatures
118 (append
119 signatures
120 (c++-scan-features-in-class
121 class open-brace-point
122 (point)))))))))))))
123 (if skip-tags
124 nil
125 (c++-get-feature-tags buffer-file-name (c++-sort-features signatures))
126 (or skip-tags-cleanup (br-feature-tags-save)))
127 (or no-kill (kill-buffer (current-buffer)))
128 (cons classes (delq nil parents))))
129
130 (defun c++-class-definition-regexp (class &optional regexp-flag)
131 "Return regexp to uniquely match the definition of CLASS name.
132 Optional REGEXP-FLAG non-nil means CLASS has already been quoted for use in a
133 regular expression."
134 (let ((template-args-regexp (c++-template-args-regexp class)))
135 (concat "^[ \t]*"
136 (if template-args-regexp
137 ;; Only match to a class definition with the same number of
138 ;; template parameters as <class> since some modules use #ifdef
139 ;; to define classes with the same name but a different number
140 ;; of template parameters.
141 (format "\\(template[ \t\n\^M]*%s[ \t\n\^M]*\\)"
142 template-args-regexp))
143 c++-class-keyword
144 (if regexp-flag
145 (c++-class-non-template-name class)
146 (regexp-quote (c++-class-non-template-name class)))
147 c++-class-name-after)))
148
149 (defun c++-template-args-regexp (class)
150 "Return a regexp matching the number of template args in CLASS or nil when there are no such arguments."
151 (if (string-match "<[^!]+>\\'" class)
152 (let* ((param "[^,<>]+")
153 (comma (concat "," param)))
154 (format "<%s%s>"
155 param (mapconcat
156 (function (lambda (c) (if (= c ?\,) comma)))
157 (substring class (1+ (match-beginning 0))
158 (1- (match-end 0)))
159 "")))))
160
161 ;; Remove only *trailing* template identifiers when class name is looked up.
162 (defun c++-class-non-template-name (class)
163 "Return CLASS name sans any trailing <template> component.
164 Does not remove whitespace from CLASS."
165 (if (and (stringp class) (string-match "<[^!]+>\\'" class))
166 (substring class 0 (match-beginning 0))
167 class))
168
169 (defun c++-get-class-name (class-name template-signature rename-arguments-flag)
170 "Return a possibly, parameterized class identifier built from CLASS-NAME and TEMPLATE-SIGNATURE.
171 If RENAME-ARGUMENTS-FLAG is non-nil, template class argument names are
172 normalized also to T1,T2,T3, etc.
173 TEMPLATE-SIGNATURE may be of any of the following forms:
174 nil
175 template <class T>
176 template <class T1, class T2>
177 <class T1, class T2>
178 <int = 0>."
179 (cond ((null template-signature)
180 class-name)
181 ((stringp template-signature)
182 (let ((types) (start 0))
183 (while (string-match
184 c++-template-parameter-regexp
185 template-signature start)
186 (setq start (match-end 0)
187 types (cons (substring
188 template-signature
189 (match-beginning c++-template-parameter-grpn)
190 (match-end c++-template-parameter-grpn))
191 types)))
192 (if (null types)
193 class-name
194 (setq class-name
195 (format "%s<%s>" class-name
196 (mapconcat 'identity (nreverse types) ",")))
197 (if rename-arguments-flag
198 (c++-normalize-template-arguments class-name)
199 class-name))))
200 (t (error "(c++-get-class-name): Second argument, '%s', must be a string or nil."
201 template-signature))))
202
203 (defun c++-normalize-class-match (rename-arguments-flag)
204 "After a regexp match to a class definition, return the matching class name.
205 Class name is normalized for use in OO-Browser lookups.
206 If RENAME-ARGUMENTS-FLAG is non-nil, template class argument names are
207 normalized also to T1,T2,T3, etc."
208 (c++-get-class-name
209 (buffer-substring (match-beginning c++-class-def-name-grpn)
210 (match-end c++-class-def-name-grpn))
211 (if (match-beginning c++-class-def-template-grpn)
212 (buffer-substring
213 (match-beginning c++-class-def-template-grpn)
214 (match-end c++-class-def-template-grpn)))
215 rename-arguments-flag))
216
217 (defun c++-normalize-template-arguments (class)
218 "Return class with any template arguments renamed to <T> or <T1,T2,T3>."
219 (setq class (br-delete-space class))
220 (cond ((not (string-match "[<,][ \t\n\^M]*[^,>]*[,>]" class))
221 ;; No type parameters.
222 class)
223 ;;
224 ;; Some type parameter.
225 ((= ?> (aref class (1- (match-end 0))))
226 ;; Class has only one type parameter.
227 (hypb:replace-match-string c++-template-parameter-regexp
228 class "<T>" t))
229 (t
230 ;; Class has two or more type parameters.
231 (let ((count 1) (start 0) before after)
232 (while (string-match "[<,][ \t\n\^M]*[^,>]*" class start)
233 (setq before (substring class
234 0 (1+ (match-beginning 0)))
235 after (substring class (match-end 0))
236 class
237 (format "%sT%d%s" before count after)
238 ;; class may have just shrunk, so don't use
239 ;; match-data from above string-match below here.
240 start (- (length class) (length after))
241 count (1+ count)))
242 class))))
243
244 (defun c++-scan-parents ()
245 "Return list of parents names from a C++ class definition.
246 Point must be after the colon that begins the parent list and before the
247 first parent entry when this function is called."
248 (let ((parent-list) (again t)
249 parent)
250 (while (and again (re-search-forward c++-parent-regexp nil t))
251 (setq again (= ?, (preceding-char))
252 parent (c++-get-parent-name
253 (buffer-substring (match-beginning c++-parent-name-grpn)
254 (match-end c++-parent-name-grpn)))
255 parent-list (cons parent parent-list)))
256 (nreverse parent-list)))
257
258 (defun c++-get-parent-name (parent-name)
259 ;; We need to handle class definitions like this:
260 ;; template <class T> class PtrList : private List<type-name> {}
261 ;; where the parent class is an instantiation of a parameterized class.
262 ;; For now, we change the type name to <T> or <T1,T2,T3> when there are 3
263 ;; parameters, for purposes of class name matching.
264 ;;
265 ;; Test cases:
266 ;;
267 ;; (mapcar 'c++-get-parent-name
268 ;; '("par <class _T1=myclass , class _T2 = you >" "parent"
269 ;; "class<_T1,T2>" "class< __me , int>" "" "<template>"
270 ;; "par<_template>"))
271 ;; Should yield:
272 ;; ("par<T1,T2>" "parent" "class<T1,T2>" "class<T1,T2>" "" "<template>"
273 ;; "par<T>")
274 ;;
275 (if (string-match "<\\(.\\|\n\\)+>\\'" parent-name)
276 (let ((parent (substring parent-name 0 (match-beginning 0)))
277 (template (substring parent-name (match-beginning 0))))
278 (setq parent (hypb:replace-match-string "\\s " parent "" t)
279 parent-name (c++-get-class-name parent template t)))
280 parent-name))
281
282 (defun c++-get-parents-from-source (filename class-name)
283 "Scan source in FILENAME and return list of parents of CLASS-NAME.
284 Assume file existence has already been checked."
285 (or (null class-name)
286 (car (car (br-rassoc
287 class-name
288 (cdr (c++-get-classes-from-source filename t)))))))
289
290 (defun c++-select-path (paths-htable-elt &optional feature-p)
291 "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
292 Selection is between path of class definition and path for features associated
293 with the class."
294 (let ((elt (cdr paths-htable-elt)))
295 (if (consp elt)
296 (if feature-p (cdr elt) (car elt))
297 ;; Both paths are the same.
298 elt)))
299
300 (defun c++-set-case (type)
301 "Return string TYPE identifier for use as a class name."
302 type)
303
304 (defun c++-set-case-type (class-name)
305 "Return string CLASS-NAME for use as a type identifier."
306 class-name)
307
308 (defun c++-to-class-end ()
309 "Assuming point is at start of class, move to start of line after end of class."
310 (interactive)
311 (condition-case ()
312 (forward-list)
313 (error (progn (or (re-search-forward "^}" nil t)
314 (goto-char (point-max))))))
315 (forward-line 1))
316
317 (defun c++-to-comments-begin ()
318 "Skip back from current point past any preceding blank lines and comments.
319 Presumes no \"/*\" strings are nested within multi-line comments."
320 (let ((opoint))
321 (while (progn (setq opoint (point))
322 ;; To previous line
323 (if (= 0 (forward-line -1))
324 (cond
325 ;; If begins with "//" or ends with "*/", then is a
326 ;; comment.
327 ((looking-at "[ \t]*\\(//\\|$\\)"))
328 ((looking-at ".*\\*/[ \t]*$")
329 (end-of-line)
330 ;; Avoid //*** single line comments here.
331 (re-search-backward "\\(^\\|[^/]\\)/\\*" nil t))
332 ((looking-at "[ \t]*$"))))))
333 (goto-char opoint)
334 ;; Skip past whitespace
335 (skip-chars-forward " \t\n")
336 (beginning-of-line)))
337
338 ;;; ************************************************************************
339 ;;; Internal variables
340 ;;; ************************************************************************
341
342 (defconst c++-template-prefix
343 "\\(template[ \t\n\^M]*<[^>;.{}]+>[ \t\n\^M]*\\)?"
344 "Regexp matching a template class or element definition or declaration.
345 Entire expression is an optional match, so it may be added as a conditional
346 expression to other regexps.")
347
348 (defconst c++-class-name-before
349 (concat "^[ \t]*" c++-template-prefix c++-class-keyword)
350 "Regexp preceding the class name in a class definition.")
351
352 (defconst c++-comment-regexp "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*")
353
354 (defconst c++-class-name-after
355 (concat c++-comment-regexp "\\([{:]\\)")
356 "Regexp following the class name in a class definition.
357 Last character matched is either the colon preceding the list of class
358 parents, or the curly brace beginning the class body definition.")
359
360 (defconst c++-identifier-chars "_~<>a-zA-Z0-9"
361 "String of chars and char ranges that may be used within a C++ or G++ identifier.")
362
363 (defconst c++-template-identifier-chars "_a-zA-Z0-9"
364 "String of chars and char ranges that may be used within a standard C++ template identifier.
365 This excludes the template arguments.")
366
367 (defconst c++-return-type-chars "_<>a-zA-Z0-9"
368 "String of chars and char ranges that may be used within a C++ or G++ return type identifier.")
369
370 ;; Modified on 3/28/95 to handle C++ names with multiple template
371 ;; parameters, e.g. class<T1,T2,T3>.
372 (defconst c++-identifier (concat
373 "\\([_~<a-zA-Z][" c++-template-identifier-chars "]*"
374 "[ \t\n\^M]*<[^>;{}]+[ \t\n\^M>]*>\\|[_~<a-zA-Z]["
375 c++-identifier-chars "]*\\)")
376 "Regular expression matching a C++ or G++ identifier.")
377
378 (defconst c++-class-def-regexp
379 (concat c++-class-name-before c++-identifier c++-class-name-after)
380 "Regular expression used to match to class definitions in source text.
381 Class name identifier is grouping 'c++-class-def-name-grpn'. Optional
382 class template parameter signature is grouping 'c++-class-def-template-grpn'.
383 ':' derived class indicator begins grouping 'c++-class-def-derived-grpn,'
384 unless the class is not derived, in which case this grouping begins with
385 '{'.")
386
387 (defconst c++-class-def-template-grpn 1)
388 (defconst c++-class-def-name-grpn 3)
389 (defconst c++-class-def-derived-grpn 5)
390
391 (defconst c++-lang-prefix "c++-"
392 "Prefix string that starts \"br-c++.el\" symbol names.")
393
394 (defconst c++-parent-regexp
395 (concat c++-comment-regexp
396 "\\(\\(public\\|private\\|protected\\|virtual\\)[ \t\n]+"
397 "\\(\\(public\\|private\\|protected\\|virtual\\)[ \t\n]+\\)?\\)?"
398 c++-identifier c++-comment-regexp "[,{;]")
399 "Parent identifier is group 'c++-parent-name-grpn'.")
400
401 (defconst c++-parent-name-grpn 6)
402
403 (defconst c++-template-parameter-regexp
404 "[< \t\n\^M]+\\([^=<> \t\n\^M]+\\)[ \t\n\^M]*\\(=[^,>]+\\)?[,>]"
405 "Regexp matching a single C++ <template> specifier argument name.
406 For example in 'template <class T, int size = 0>', there are two parameter
407 names, 'T' and 'size'. The parameter name is grouping
408 'c++-template-parameter-grpn'.")
409
410 (defconst c++-template-parameter-grpn 1)
411
412 ;; Ellemtel C++ recommendations specify that inline definition files should
413 ;; use the suffix ".icc" and other people use ".I" for such files, so those
414 ;; suffixes are included here.
415 (defconst c++-src-file-regexp
416 "[^.]\\.\\([ch]xx\\|[chCH][chpCHP]?[pP]?\\|icc\\|I\\)$"
417 "Regular expression matching a unique part of C++ source or header file name and no others.")
418
419 (defvar c++-children-htable nil
420 "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
421 Used to traverse C++ inheritance graph. 'br-build-children-htable' builds
422 this list.")
423 (defvar c++-parents-htable nil
424 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
425 Used to traverse C++ inheritance graph. 'br-build-parents-htable' builds
426 this list.")
427 (defvar c++-paths-htable nil
428 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
429 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
430 'br-build-paths-htable' builds this list.")
431
432
433 (defvar c++-lib-parents-htable nil
434 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
435 Only classes from stable software libraries are used to build the list.")
436 (defvar c++-lib-paths-htable nil
437 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
438 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
439 Only classes from stable software libraries are used to build the list.")
440
441 (defvar c++-sys-parents-htable nil
442 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
443 Only classes from systems that are likely to change are used to build the list.")
444 (defvar c++-sys-paths-htable nil
445 "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
446 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
447 Only classes from systems that are likely to change are used to build the
448 list.")
449
450 (defvar c++-lib-prev-search-dirs nil
451 "Used to check if 'c++-lib-classes-htable' must be regenerated.")
452 (defvar c++-sys-prev-search-dirs nil
453 "Used to check if 'c++-sys-classes-htable' must be regenerated.")
454
455 (defvar c++-env-spec nil
456 "Non-nil value means Environment specification has been given but not yet built.
457 Nil means current Environment has been built, though it may still require updating.")
458
459 (provide 'br-c++)