Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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-objc.el
4 ;; SUMMARY: Support routines for Objective-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:31:05 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 ;; See 'objc-class-def-regexp' for regular expression that matches class
22 ;; definitions.
23 ;;
24 ;; DESCRIP-END.
25
26 ;;; ************************************************************************
27 ;;; Other required Elisp libraries
28 ;;; ************************************************************************
29
30 (mapcar 'require '(br-lib br-c-ft))
31
32 ;;; ************************************************************************
33 ;;; Public variables
34 ;;; ************************************************************************
35
36 (defvar objc-lib-search-dirs nil
37 "List of directories below which Objective-C Library source files are found.
38 Subdirectories of Library source are also searched. A Library is a stable
39 group of classes.")
40
41 (defvar objc-sys-search-dirs nil
42 "List of directories below which Objective-C System source files are found.
43 Subdirectories of System source are also searched. A System class is one
44 that is not yet reusable and is likely to change before release.")
45
46 (defconst objc-narrow-view-to-class nil
47 "*Non-nil means narrow buffer to just the matching class definition when displayed.")
48
49 ;;; ************************************************************************
50 ;;; Public functions
51 ;;; ************************************************************************
52
53 (defun objc-get-classes-from-source (filename &optional skip-tags
54 skip-tags-cleanup)
55 "Scans FILENAME and returns cons of class list with parents-class alist.
56 Assumes file existence and readability have already been checked.
57 With optional SKIP-TAGS non-nil, does not compute and store lookup tags
58 for feature definitions. If SKIP-TAGS is nil, normally a cleanup
59 routine is called after scanning the features. SKIP-TAGS-CLEANUP
60 non-nil suppresses this action."
61 (let ((no-kill (get-file-buffer filename))
62 (parents-and-class)
63 (signatures)
64 class class-of-category class-separator class-type
65 classes category def-match-data in-comment-flag parent-list
66 protocol-list)
67 (if no-kill
68 (set-buffer no-kill)
69 (funcall br-view-file-function filename))
70 (save-excursion
71 (save-restriction
72 (widen)
73 (goto-char (point-min))
74 (if skip-tags
75 nil
76 ;; Get all method definitions within this file.
77 (setq signatures (objc-scan-features))
78 (goto-char (point-min)))
79 ;; Search for class or protocol interface specification.
80 (while (re-search-forward objc-class-def-regexp nil t)
81 (setq class nil class-type nil
82 category nil parent-list nil protocol-list nil
83 def-match-data (match-data))
84 ;;
85 ;; If definition is within a C comment, ignore it.
86 ;; Regexp used for matching a def precludes any "//"
87 ;; comment.
88 (if (setq in-comment-flag
89 (and (c-within-comment-p) (search-forward "*/" nil t)))
90 nil
91 (store-match-data def-match-data)
92 (setq class-type (buffer-substring
93 (match-beginning objc-class-def-type-grpn)
94 (match-end objc-class-def-type-grpn))
95 class-separator
96 (if (match-beginning objc-class-def-separator-grpn)
97 (buffer-substring
98 (match-beginning objc-class-def-separator-grpn)
99 (match-end objc-class-def-separator-grpn)))))
100 ;;
101 (cond (in-comment-flag) ;; Ignore
102 ;;
103 ((string-equal class-type "@interface")
104 ;; Class or category definition
105 (setq class (buffer-substring
106 (match-beginning objc-class-name-grpn)
107 (match-end objc-class-name-grpn)))
108 (cond ((null class-separator)
109 ;; top class definition without any protocols,
110 ;; nothing more to do
111 )
112 ((string-equal class-separator ":")
113 ;; class definition with parent
114 (if (re-search-forward objc-parent-regexp nil t)
115 (setq parent-list
116 (list (buffer-substring
117 (match-beginning
118 objc-parent-name-grpn)
119 (match-end objc-parent-name-grpn))))
120 (error "(objc-get-classes-from-source): '%s' parent definition is invalid."
121 class))
122 ;; Check if class conforms to protocol list
123 (if (and (null skip-tags) (= (following-char) ?\<))
124 (setq protocol-list (objc-scan-protocol-list))))
125 ;;
126 ((string-equal class-separator "\(")
127 ;; class category definition
128 (if (null skip-tags)
129 ;; Check if class conforms to protocol list
130 (progn
131 (skip-chars-forward " \t\n\r")
132 (setq class-of-category
133 (buffer-substring
134 (match-beginning objc-class-name-grpn)
135 (match-end objc-class-name-grpn))
136 category
137 (if (looking-at objc-identifier)
138 (progn
139 (goto-char (match-end 0))
140 (skip-chars-forward "\) \t\n\r")
141 (concat
142 "\(" (buffer-substring
143 (match-beginning
144 objc-identifier-grpn)
145 (match-end
146 objc-identifier-grpn))
147 "\)"))
148 ;; If get here, there is a problem.
149 (error "(objc-get-classes-from-source): '%s' class contains invalid category () delimiters"))
150 class (concat class-of-category category)
151 signatures
152 ;; Add this category def to the default
153 ;; categories class.
154 (cons (objc-feature-normalize
155 ;; Yes, this net line should be
156 ;; (category)class-of-category.
157 (concat category class-of-category)
158 objc-default-category-class)
159 ;; Add a category tag to
160 ;; class-of-category.
161 (cons (objc-feature-normalize
162 category
163 class-of-category)
164 signatures)))
165 ;; Check if category conforms to protocol list
166 (if (= (following-char) ?\<)
167 (setq protocol-list
168 (objc-scan-protocol-list))))))
169 ;;
170 ((string-equal class-separator "\<")
171 ;; top class definition conforming to protocols
172 (if (null skip-tags)
173 (setq protocol-list (objc-scan-protocol-list))))
174 ;;
175 ;; If get here, there is a bug, so signal an error.
176 (t (error "(objc-get-classes-from-source): '%s' class uses '%s' unhandled definition separator"
177 class class-separator))))
178 ;;
179 (t
180 ;;
181 ;; Protocol definition
182 ;;
183 ;; Record '<'protocol-name '>' as a class along with its
184 ;; parent protocols, if any.
185 ;; If not skip-tags, add the protocol's method
186 ;; *declarations* as feature tags.
187 (setq class (concat "<"
188 (buffer-substring
189 (match-beginning objc-class-name-grpn)
190 (match-end objc-class-name-grpn))
191 ">")
192 parent-list
193 (if (string-equal class-separator "\<")
194 (objc-scan-protocol-list)))
195 (if (null skip-tags)
196 (setq signatures
197 ;; Add this protocol def to the default protocols
198 ;; class.
199 (cons (objc-feature-normalize
200 class objc-default-protocol-class)
201 signatures)))))
202 (if (null class-type)
203 nil
204 (if class (setq classes (cons class classes)
205 parents-and-class
206 (cons (cons parent-list class)
207 parents-and-class)))
208 (if protocol-list
209 ;; record all of class' protocols as tags
210 (setq signatures
211 (nconc signatures
212 (mapcar
213 (function (lambda (protocol)
214 (objc-feature-normalize
215 protocol class)))
216 protocol-list))))))))
217 (if skip-tags
218 nil
219 (objc-get-feature-tags buffer-file-name signatures)
220 (or skip-tags-cleanup (br-feature-tags-save)))
221 (or no-kill (kill-buffer (current-buffer)))
222 (cons classes (delq nil parents-and-class))))
223
224 (defun objc-get-parents-from-source (filename class-name)
225 "Scan source in FILENAME and return list of parents of CLASS-NAME.
226 Assume file existence has already been checked."
227 (or (null class-name)
228 (car (car (br-rassoc
229 class-name
230 (cdr (objc-get-classes-from-source filename t)))))))
231
232 (defun objc-select-path (paths-htable-elt &optional feature-p)
233 "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
234 Selection is between path of class definition and path for features associated
235 with the class."
236 (let ((elt (cdr paths-htable-elt)))
237 (if (consp elt)
238 (if feature-p (cdr elt) (car elt))
239 ;; Both paths are the same.
240 elt)))
241
242 (defun objc-set-case (type)
243 "Return string TYPE identifier for use as a class name."
244 type)
245
246 (defun objc-set-case-type (class-name)
247 "Return string CLASS-NAME for use as a type identifier."
248 class-name)
249
250 (defun objc-to-class-end ()
251 "Assuming point is at start of class, move to start of line after end of class."
252 (interactive)
253 (condition-case ()
254 (forward-list)
255 (error (progn (or (re-search-forward "^}" nil t)
256 (goto-char (point-max))))))
257 (forward-line 1))
258
259 (defun objc-to-comments-begin ()
260 "Skip back from current point past any preceding Objective-C comments.
261 Presumes no \"/*\" strings are nested within multi-line comments."
262 (let ((opoint))
263 (while
264 (progn (setq opoint (point))
265 ;; To previous line
266 (if (= 0 (forward-line -1))
267 (cond
268 ;; If begins with "//" or ends with "*/", then is a comment.
269 ((looking-at "[ \t]*\\(//\\|$\\)"))
270 ((looking-at ".*\\*/[ \t]*$")
271 (progn (end-of-line)
272 (search-backward "/*" nil t)))
273 (nil)))))
274 (goto-char opoint)
275 ;; Skip past whitespace
276 (skip-chars-forward " \t\n")
277 (beginning-of-line)))
278
279 ;;; ************************************************************************
280 ;;; Private variables
281 ;;; ************************************************************************
282
283 (defconst objc-class-keyword
284 "\\(@interface\\|@protocol\\)[ \t\n]+"
285 "Keyword regexp preceding an Objective-C class or protocol definition.
286 Type of definition is indicated by grouping 'objc-class-def-type-grpn'.")
287
288 (defconst objc-class-def-type-grpn 1)
289
290 (defconst objc-class-name-before
291 (concat "^[ \t]*" objc-class-keyword)
292 "Regexp preceding the class name in a class definition.")
293
294 (defconst objc-class-name-after
295 "\\([ \t\n]+//.*[\n]\\)*[ \t\n]*\\([:\<\(]\\)?"
296 "Regexp following the class name in a class definition.")
297
298 (defconst objc-interface-before
299 "^[ \t]*\\(@interface\\)[ \t\n]+"
300 "Regexp preceding the class name in a non-protocol class definition.")
301
302 (defconst objc-implementation-before
303 "^[ \t]*\\(@implementation\\)[ \t\n]+"
304 "Regexp preceding the class name in a class method definition section.")
305
306 (defconst objc-protocol-before
307 "^[ \t]*\\(@protocol\\)[ \t\n]+"
308 "Regexp preceding the protocol name in a formal protocol definition.")
309
310 (defconst objc-identifier-chars "_a-zA-Z0-9"
311 "String of chars and char ranges that may be used within an Objective-C identifier.")
312
313 (defconst objc-identifier
314 (concat "\\([_a-zA-Z][" objc-identifier-chars "]*\\)")
315 "Regular expression matching an Objective-C identifier.
316 The identifier is grouping 'objc-identifier-grpn'.")
317
318 (defconst objc-identifier-grpn 1)
319
320 (defconst objc-class-def-regexp
321 (concat objc-class-name-before objc-identifier objc-class-name-after)
322 "Regular expression used to match to class definitions in source text.
323 Type of definition is indicated by grouping 'objc-class-def-type-grpn'.
324 Class name identifier is grouping 'objc-class-name-grpn'. Entire grouped
325 expression ends with one of the following (optional grouping
326 'objc-class-def-separator-grpn'):
327 a ':', indicating that class inherits from parent class following the colon;
328 a '\(', indicating a class category definition;
329 a '<', indicating protocols to which class conforms;
330 no grouping match, indicating that this is a root class with no parent.")
331
332 (defconst objc-class-def-separator-grpn 4)
333
334 (defconst objc-lang-prefix "objc-"
335 "Prefix string that starts \"br-objc.el\" symbol names.")
336
337 (defconst objc-parent-regexp
338 (concat "[ \t\n]*" objc-identifier "\\([ \t\n]+//.*[\n]\\)?[ \t\n]*")
339 "Parent identifier is grouping 'objc-parent-name-grpn'.")
340
341 (defconst objc-parent-name-grpn 1)
342
343 (defconst objc-src-file-regexp ".\\.[hcmHCM]$"
344 "Regular expression matching a unique part of Objective-C source or header file name and no others.")
345
346 (defvar objc-children-htable nil
347 "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
348 Used to traverse Objective-C inheritance graph. 'br-build-children-htable' builds
349 this list.")
350 (defvar objc-parents-htable nil
351 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
352 Used to traverse Objective-C inheritance graph. 'br-build-parents-htable' builds
353 this list.")
354 (defvar objc-paths-htable nil
355 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
356 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
357 'br-build-paths-htable' builds this list.")
358
359
360 (defvar objc-lib-parents-htable nil
361 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
362 Only classes from stable software libraries are used to build the list.")
363 (defvar objc-lib-paths-htable nil
364 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
365 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
366 Only classes from stable software libraries are used to build the list.")
367
368 (defvar objc-sys-parents-htable nil
369 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
370 Only classes from systems that are likely to change are used to build the list.")
371 (defvar objc-sys-paths-htable nil
372 "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
373 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
374 Only classes from systems that are likely to change are used to build the
375 list.")
376
377 (defvar objc-lib-prev-search-dirs nil
378 "Used to check if 'objc-lib-classes-htable' must be regenerated.")
379 (defvar objc-sys-prev-search-dirs nil
380 "Used to check if 'objc-sys-classes-htable' must be regenerated.")
381
382 (defvar objc-env-spec nil
383 "Non-nil value means Environment specification has been given but not yet built.
384 Nil means current Environment has been built, though it may still require updating.")
385
386 (provide 'br-objc)