|
0
|
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
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 7-Dec-89
|
|
100
|
12 ;; LAST-MOD: 21-Feb-97 at 17:22:55 by Bob Weiner
|
|
0
|
13 ;;
|
|
100
|
14 ;; Copyright (C) 1989-1995, 1997 Free Software Foundation, Inc.
|
|
0
|
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)
|
