|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-objc-ft.el
|
|
|
4 ;; SUMMARY: Objective-C OO-Browser class and feature functions.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: c, oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Motorola Inc.
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 03-Oct-90
|
|
|
12 ;; LAST-MOD: 5-May-95 at 15:57:14 by Bob Weiner
|
|
|
13 ;;
|
|
|
14 ;; Copyright (C) 1990-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 ;; DESCRIP-END.
|
|
|
21
|
|
|
22 ;;; ************************************************************************
|
|
|
23 ;;; Other required Elisp libraries
|
|
|
24 ;;; ************************************************************************
|
|
|
25
|
|
|
26 (require 'br-objc)
|
|
|
27
|
|
|
28 ;;; ************************************************************************
|
|
|
29 ;;; Public variables
|
|
|
30 ;;; ************************************************************************
|
|
|
31
|
|
|
32 (defconst objc-default-category-class "[category]"
|
|
|
33 "Name of the default class whose instances are Objective-C categories.")
|
|
|
34
|
|
|
35 (defconst objc-default-protocol-class "[protocol]"
|
|
|
36 "Name of the default class whose instances are Objective-C protocols.")
|
|
|
37
|
|
|
38 (defconst objc-type-identifier
|
|
|
39 (concat "[a-zA-Z][" objc-identifier-chars "]*[ \t\n]*[*&]*"))
|
|
|
40
|
|
|
41 (defconst objc-type-tag-separator "@"
|
|
|
42 "String that separates a tag's type from its normalized definition form.")
|
|
|
43
|
|
|
44 (defconst objc-tag-fields-regexp
|
|
|
45 ;; The \\\\? below is necessary because we sometimes use this expression to
|
|
|
46 ;; test against a string that has ben regexp-quoted and some of the
|
|
|
47 ;; characters in br-feature-type-regexp will then be preceded by \\.
|
|
|
48 (format "\\`\\([^*& \n]+\\)%s\\\\?\\(%s \\)\\([^%s\n]+\\)\\(%s\\|\\'\\)"
|
|
|
49 objc-type-tag-separator br-feature-type-regexp
|
|
|
50 objc-type-tag-separator objc-type-tag-separator)
|
|
|
51 "Regexp matching the fields of an Objective-C feature tag line.
|
|
|
52 Group 1 is the class of the feature. Group 2 is the prefix preceding the
|
|
|
53 feature when displayed within a listing buffer. Group 3 is the feature name.
|
|
|
54 The feature definition signature begins at the end of the regexp match,
|
|
|
55 i.e. (match-end 0), and goes to the end of the string or line.")
|
|
|
56
|
|
|
57 (defvar objc-cpp-include-dirs '("/usr/include/")
|
|
|
58 "*Ordered list of include directories by default searched by C preprocessor.
|
|
|
59 Each directory must end with a directory separator. See also
|
|
|
60 'objc-include-dirs'.")
|
|
|
61
|
|
|
62 (defvar objc-include-dirs nil
|
|
|
63 "*Ordered list of directories to search for Objective-C include files.
|
|
|
64 Each directory must end with a directory separator. Directories normally
|
|
|
65 searched by the Objective-C pre-processor should be set instead in
|
|
|
66 'objc-cpp-include-dirs'.")
|
|
|
67
|
|
|
68 ;;; ************************************************************************
|
|
|
69 ;;; Public functions
|
|
|
70 ;;; ************************************************************************
|
|
|
71
|
|
|
72 (defun objc-add-default-classes ()
|
|
|
73 ;; Add to 'system' class table.
|
|
|
74 (mapcar (function (lambda (class) (br-add-class class br-null-path nil)))
|
|
|
75 (list objc-default-category-class objc-default-protocol-class))
|
|
|
76 (if br-c-tags-flag (c-add-default-classes)))
|
|
|
77
|
|
|
78 (defun objc-class-definition-name (class)
|
|
|
79 "Convert CLASS name to the way it appears in its source code definition.
|
|
|
80 Returns a regular expression."
|
|
|
81 (cond ((string-match "^<.+>$" class)
|
|
|
82 ;; Remove <> delimiters from protocol class.
|
|
|
83 (regexp-quote (substring class 1 -1)))
|
|
|
84 ((string-match "^\\([^ \(]+\\) *(\\([^\)]*\\)) *$" class)
|
|
|
85 ;; Allow for whitespace within class(category)
|
|
|
86 (format "%s[ \t\n\r]*([ \t\n\r]*%s[ \t\n\r]*)"
|
|
|
87 (regexp-quote
|
|
|
88 (substring class (match-beginning 1) (match-end 1)))
|
|
|
89 (regexp-quote
|
|
|
90 (substring class (match-beginning 2) (match-end 2)))))
|
|
|
91 ((string-match "^(\\([^\)]*\\)) *\\([^ ]+\\) *$" class)
|
|
|
92 ;; Allow for whitespace within (category)class
|
|
|
93 (format "%s[ \t\n\r]*([ \t\n\r]*%s[ \t\n\r]*)"
|
|
|
94 (regexp-quote
|
|
|
95 (substring class (match-beginning 2) (match-end 2)))
|
|
|
96 (regexp-quote
|
|
|
97 (substring class (match-beginning 1) (match-end 1)))))
|
|
|
98 (t (regexp-quote class))))
|
|
|
99
|
|
|
100 (defun objc-class-definition-regexp (class)
|
|
|
101 "Return regexp to uniquely match the definition of CLASS name."
|
|
|
102 (concat objc-class-name-before (objc-class-definition-name class)
|
|
|
103 objc-class-name-after))
|
|
|
104
|
|
|
105 (defun objc-feature-implementors (ftr-name)
|
|
|
106 "Return unsorted list of Objective-C feature tags which implement FTR-NAME."
|
|
|
107 (objc-feature-matches ftr-name))
|
|
|
108
|
|
|
109 (defun objc-feature-locate-p (feature-tag &optional regexp-flag)
|
|
|
110 "Leaves point at the start of FEATURE-TAG's definition in the current buffer.
|
|
|
111 Assumes caller has moved point to the beginning of the buffer or to the point
|
|
|
112 of desired search start.
|
|
|
113 Optional REGEXP-FLAG means FEATURE-TAG is a regular expression."
|
|
|
114 ;; Match to function definitions, not declarations.
|
|
|
115 (let ((found) (start))
|
|
|
116 ;; First move to the proper class implementation if this is not a
|
|
|
117 ;; [default-class], so that if two classes in the same file have the same
|
|
|
118 ;; feature signature, we still end up at the right one.
|
|
|
119 (if (and (not (string-match (if regexp-flag "\\`\\\\\\[" "\\`\\[")
|
|
|
120 feature-tag))
|
|
|
121 (string-match objc-tag-fields-regexp feature-tag))
|
|
|
122 (let ((class
|
|
|
123 (substring feature-tag (match-beginning 1) (match-end 1))))
|
|
|
124 ;; Protocols don't define methods, they only declare them, so we
|
|
|
125 ;; know we can't be searching for a protocol method definition
|
|
|
126 ;; here, and so there is no special case handling.
|
|
|
127 (re-search-forward (concat objc-implementation-before
|
|
|
128 ;; Assume regexp-quoted class is the
|
|
|
129 ;; same as non-regexp-quoted version
|
|
|
130 ;; since this call will regexp-quote it
|
|
|
131 ;; again; we have no way of
|
|
|
132 ;; un-regexp-quoting it.
|
|
|
133 (objc-class-definition-name class))
|
|
|
134 nil t)))
|
|
|
135 ;;
|
|
|
136 ;; Now search for feature.
|
|
|
137 (or regexp-flag (setq feature-tag
|
|
|
138 (objc-feature-signature-to-regexp feature-tag)))
|
|
|
139 (while (and (re-search-forward feature-tag nil t)
|
|
|
140 (setq start (match-beginning 0))
|
|
|
141 (not (setq found (not (if (c-within-comment-p)
|
|
|
142 (progn (search-forward "*/" nil t)
|
|
|
143 t)))))))
|
|
|
144 (if found
|
|
|
145 (progn (goto-char start)
|
|
|
146 (skip-chars-forward " \t\n")
|
|
|
147 (objc-to-comments-begin)
|
|
|
148 (recenter 0)
|
|
|
149 (goto-char start)
|
|
|
150 t))))
|
|
|
151
|
|
|
152 (defun objc-feature-name-to-regexp (name)
|
|
|
153 "Converts feature NAME into a regular expression matching the feature's name tag."
|
|
|
154 (cond
|
|
|
155 ;;
|
|
|
156 ;; protocol name
|
|
|
157 ((= (aref name 0) ?\<) (regexp-quote name))
|
|
|
158 ;;
|
|
|
159 ;; category name
|
|
|
160 ((= (aref name 0) ?\()
|
|
|
161 ;; Drop any class name following the category.
|
|
|
162 (regexp-quote
|
|
|
163 (substring name 0 (1+ (string-match "\)" name)))))
|
|
|
164 ;;
|
|
|
165 ;; feature tag
|
|
|
166 ((string-match objc-tag-fields-regexp name)
|
|
|
167 (concat
|
|
|
168 "^" (regexp-quote (substring name (match-beginning 0) (match-end 0)))))
|
|
|
169 ;;
|
|
|
170 ;; unrecognized name format
|
|
|
171 (t (error "(objc-feature-name-to-regexp): Invalid name, '%s'" name))))
|
|
|
172
|
|
|
173 (defun objc-feature-signature-to-name (signature &optional with-class for-display)
|
|
|
174 "Extracts the feature name from SIGNATURE.
|
|
|
175 SIGNATURE may be a feature tag line or a signature extracted from source code.
|
|
|
176 The feature's class name is dropped from signature unless optional WITH-CLASS
|
|
|
177 is non-nil. The feature's type (class feature = +, instance feature = -)
|
|
|
178 is dropped unless FOR-DISPLAY is non-nil."
|
|
|
179
|
|
|
180 ;; feature tag
|
|
|
181 (if (string-match objc-tag-fields-regexp signature)
|
|
|
182 (cond ((and with-class for-display)
|
|
|
183 (substring signature (match-beginning 1) (match-end 3)))
|
|
|
184 (for-display
|
|
|
185 (substring signature (match-beginning 2) (match-end 3)))
|
|
|
186 (with-class
|
|
|
187 (concat
|
|
|
188 (substring signature (match-beginning 1) (1+ (match-end 1)))
|
|
|
189 (substring signature (match-beginning 3) (match-end 3))))
|
|
|
190 (t (substring signature (match-beginning 3) (match-end 3))))
|
|
|
191 ;;
|
|
|
192 ;; source code signature
|
|
|
193 (let ((loop-p t)
|
|
|
194 (name-part (concat "\\`" objc-name-part objc-name-sep))
|
|
|
195 (name-type (concat "\\`" objc-name-part objc-type-sep))
|
|
|
196 (name))
|
|
|
197 (cond ((or (= (aref signature 0) ?\<) (= (aref signature 0) ?\())
|
|
|
198 ;; protocol or category tags
|
|
|
199 (setq name
|
|
|
200 (if for-display
|
|
|
201 (concat "@ " signature)
|
|
|
202 signature)))
|
|
|
203 ((string-match (concat "\\`" br-feature-type-regexp) signature)
|
|
|
204 ;; regular feature signature
|
|
|
205 (if for-display
|
|
|
206 (setq name (concat (substring signature (match-beginning 0)
|
|
|
207 (match-end 0))
|
|
|
208 " ")))
|
|
|
209 (setq signature (concat (substring signature (match-end 0)) ";"))
|
|
|
210 (while (and loop-p (string-match name-part signature))
|
|
|
211 ;; Handles named or unnamed parameters.
|
|
|
212 (if (match-beginning objc-name-part-id)
|
|
|
213 (setq name (concat name
|
|
|
214 (substring
|
|
|
215 signature
|
|
|
216 (match-beginning objc-name-part-id)
|
|
|
217 (match-end objc-name-part-id)))))
|
|
|
218 (if (/= (aref signature (1- (match-end 0))) ?:)
|
|
|
219 (setq loop-p nil
|
|
|
220 signature (substring signature (match-end 0)))
|
|
|
221 (setq name (concat name ":")
|
|
|
222 signature (substring signature (match-end 0)))
|
|
|
223 (if (string-match name-type signature)
|
|
|
224 (setq signature (substring signature (match-end 0)))))))
|
|
|
225 (t (error
|
|
|
226 "(objc-feature-signature-to-name): Invalid signature, '%s'"
|
|
|
227 signature)))
|
|
|
228 name)))
|
|
|
229
|
|
|
230 (defun objc-feature-signature-to-regexp (signature)
|
|
|
231 "Return regexp to match the definition of an Objective-C element SIGNATURE.
|
|
|
232 SIGNATURE may be a feature tag line or a signature extracted from source code."
|
|
|
233 (cond ((string-match
|
|
|
234 (format
|
|
|
235 "^\\([^*& \n]+\\)%s%s [^%s\n]+%s\\([\<\(][^\>\)\n]+[\>\)]\\(%s\\)?\\)"
|
|
|
236 objc-type-tag-separator br-feature-type-regexp
|
|
|
237 objc-type-tag-separator objc-type-tag-separator
|
|
|
238 objc-identifier)
|
|
|
239 signature)
|
|
|
240 ;; protocol or category signature
|
|
|
241 (let ((class (substring signature (match-beginning 1) (match-end 1)))
|
|
|
242 (element (substring signature (match-beginning 2)
|
|
|
243 (match-end 2))))
|
|
|
244 (if (= (aref element 0) ?\<)
|
|
|
245 (if (string-equal class objc-default-protocol-class)
|
|
|
246 ;; find def of protocol
|
|
|
247 (concat objc-protocol-before
|
|
|
248 (objc-class-definition-name element)
|
|
|
249 "[\< \t\n\r]")
|
|
|
250 ;; find def of class which conforms to protocol
|
|
|
251 (concat objc-interface-before
|
|
|
252 (objc-class-definition-name class)
|
|
|
253 objc-class-name-after
|
|
|
254 "[^\>\{]*[\<,][ \t\n\r]*"
|
|
|
255 (objc-class-definition-name element)
|
|
|
256 "[ \t\n\r]*[\>,]"))
|
|
|
257 (if (string-equal class objc-default-category-class)
|
|
|
258 ;; find def of '[category]@(category-name)class-name'
|
|
|
259 (concat objc-interface-before
|
|
|
260 (objc-class-definition-name element))
|
|
|
261 ;; find def of 'class-name@(category-name)'
|
|
|
262 (concat objc-interface-before
|
|
|
263 (objc-class-definition-name (concat class element)))))))
|
|
|
264 ;;
|
|
|
265 (t
|
|
|
266 ;; regulare feature tag
|
|
|
267 (setq signature (regexp-quote signature))
|
|
|
268 (if (string-match objc-tag-fields-regexp signature)
|
|
|
269 ;;
|
|
|
270 ;; We must leave the class name as an optional component at the
|
|
|
271 ;; start of the signature so that functions that lookup feature
|
|
|
272 ;; definitions can use it to ensure that the definition is found
|
|
|
273 ;; within the right class.
|
|
|
274 (setq signature
|
|
|
275 (concat
|
|
|
276 "\\(" (substring signature (match-beginning 1)
|
|
|
277 (match-end 1))
|
|
|
278 objc-type-tag-separator "\\)?"
|
|
|
279 (substring signature (match-end 0)))))
|
|
|
280 (let ((pat) (i 0) (c) (len (length signature)))
|
|
|
281 (while (< i len)
|
|
|
282 (setq c (aref signature i)
|
|
|
283 pat (cond ((= c ? )
|
|
|
284 (concat pat "[ \t\n\^M]*"))
|
|
|
285 (t
|
|
|
286 (concat pat (char-to-string c))))
|
|
|
287 i (1+ i)))
|
|
|
288 (if (= ?{ (aref pat (1- (length pat))))
|
|
|
289 (setq pat (concat (substring pat 0 -1)
|
|
|
290 "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{"))
|
|
|
291 pat)))))
|
|
|
292
|
|
|
293 (defun objc-feature-tree-command-p (class-or-signature)
|
|
|
294 "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil."
|
|
|
295 (if (br-in-browser) (br-to-view-window))
|
|
|
296 (br-feature-found-p (br-feature-file class-or-signature)
|
|
|
297 class-or-signature))
|
|
|
298
|
|
|
299 (defun objc-list-categories (class)
|
|
|
300 "Return sorted list of Objective-C CLASS categories."
|
|
|
301 (let ((obuf (current-buffer))
|
|
|
302 (categories)
|
|
|
303 class-tag)
|
|
|
304 (cond ((string-equal class objc-default-category-class)
|
|
|
305 (objc-list-features class))
|
|
|
306 ((= (aref class 0) ?\[)
|
|
|
307 ;; Any other default classes belong to no categories.
|
|
|
308 nil)
|
|
|
309 (t
|
|
|
310 (setq class-tag (concat "\n" class objc-type-tag-separator "\("))
|
|
|
311 (set-buffer
|
|
|
312 (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
313 (goto-char 1)
|
|
|
314 ;; Use a string match for speed.
|
|
|
315 (while (search-forward class-tag nil t)
|
|
|
316 (setq categories (cons (br-feature-current) categories)))
|
|
|
317 (set-buffer obuf)
|
|
|
318 (objc-sort-features (nreverse categories))))))
|
|
|
319
|
|
|
320 (defun objc-list-features (class &optional indent)
|
|
|
321 "Return sorted list of Objective-C features lexically defined in CLASS."
|
|
|
322 (let ((obuf (current-buffer))
|
|
|
323 (features)
|
|
|
324 class-tag
|
|
|
325 search-function)
|
|
|
326 (if (= (aref class 0) ?\[)
|
|
|
327 ;; Default class of protocols or categories. Use a string match
|
|
|
328 ;; for speed.
|
|
|
329 (setq search-function 'search-forward
|
|
|
330 class-tag (concat "\n" class objc-type-tag-separator))
|
|
|
331 (setq search-function 're-search-forward
|
|
|
332 class-tag
|
|
|
333 ;; Include methods defined in any of the class' categories.
|
|
|
334 (concat "^" class "\\(([^\)]*)\\)?" objc-type-tag-separator)))
|
|
|
335 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
336 (goto-char 1)
|
|
|
337 (while (funcall search-function class-tag nil t)
|
|
|
338 (setq features (cons (br-feature-current) features)))
|
|
|
339 (set-buffer obuf)
|
|
|
340 (objc-sort-features (nreverse features))))
|
|
|
341
|
|
|
342 (defun objc-list-protocols (class)
|
|
|
343 "Return sorted list of Objective-C CLASS protocols."
|
|
|
344 (let ((obuf (current-buffer))
|
|
|
345 (protocols)
|
|
|
346 class-tag)
|
|
|
347 (cond ((string-equal class objc-default-protocol-class)
|
|
|
348 (objc-list-features class))
|
|
|
349 ((= (aref class 0) ?\[)
|
|
|
350 ;; Any other default classes conform to no formal protocols.
|
|
|
351 nil)
|
|
|
352 (t
|
|
|
353 (setq class-tag (concat "\n" class objc-type-tag-separator "\<"))
|
|
|
354 (set-buffer
|
|
|
355 (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
356 (goto-char 1)
|
|
|
357 ;; Use a string match for speed.
|
|
|
358 (while (search-forward class-tag nil t)
|
|
|
359 (setq protocols (cons (br-feature-current) protocols)))
|
|
|
360 (set-buffer obuf)
|
|
|
361 (objc-sort-features (nreverse protocols))))))
|
|
|
362
|
|
|
363 (defun objc-routine-at-point-p ()
|
|
|
364 "Returns name of Objective-C routine signature at point or nil.
|
|
|
365 If called interactively, it prints the name in the minibuffer."
|
|
|
366 (interactive)
|
|
|
367 (save-excursion
|
|
|
368 (if (and (re-search-backward "[-+\n\^M]\\|\\`" nil t)
|
|
|
369 (looking-at "[ \t\n\^M]*[-+]"))
|
|
|
370 (let ((name "") (loop-p t)
|
|
|
371 (name-part (concat objc-name-part objc-name-sep))
|
|
|
372 (name-type (concat objc-name-part objc-type-sep)))
|
|
|
373 (goto-char (match-end 0))
|
|
|
374 (while (and loop-p (looking-at name-part))
|
|
|
375 ;; Handles named or unamed parameters.
|
|
|
376 (if (match-beginning objc-name-part-id)
|
|
|
377 (setq name (concat name
|
|
|
378 (buffer-substring
|
|
|
379 (match-beginning objc-name-part-id)
|
|
|
380 (match-end objc-name-part-id)))))
|
|
|
381 (goto-char (match-end 0))
|
|
|
382 (if (/= (preceding-char) ?:)
|
|
|
383 (setq loop-p nil)
|
|
|
384 (setq name (concat name ":"))
|
|
|
385 (if (looking-at name-type) (goto-char (match-end 0)))
|
|
|
386 ))
|
|
|
387 (if (interactive-p)
|
|
|
388 (message name)
|
|
|
389 name)))))
|
|
|
390
|
|
|
391 (defun objc-scan-features ()
|
|
|
392 "Return reverse ordered list of Objective-C routine definitions in current buffer.
|
|
|
393 Assume point is at beginning of widened buffer."
|
|
|
394 (save-excursion
|
|
|
395 (let ((routines) (rout) (class-end)
|
|
|
396 class category)
|
|
|
397 (while (re-search-forward
|
|
|
398 (concat "^@implementation[ \t\n\r]+" objc-identifier
|
|
|
399 "\\([ \t\n\r]*([ \t\n\r]*" objc-identifier
|
|
|
400 "[ \t\n\r]*)\\)?")
|
|
|
401 nil t)
|
|
|
402 (setq category (if (match-beginning 3)
|
|
|
403 (buffer-substring (match-beginning 3)
|
|
|
404 (match-end 3)))
|
|
|
405 class (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
406 class (if category (format "%s(%s)" class category) class))
|
|
|
407 (save-excursion
|
|
|
408 (if (search-forward "\n@end" nil t)
|
|
|
409 (setq class-end (point))
|
|
|
410 (error "(objc-scan-features): %s, at char %d, @implementation without @end.")))
|
|
|
411 (while (re-search-forward objc-routine-def class-end t)
|
|
|
412 (setq rout (buffer-substring (match-beginning 0)
|
|
|
413 (match-end 0)))
|
|
|
414 (if (c-within-comment-p)
|
|
|
415 (search-forward "*/" nil t)
|
|
|
416 (backward-char) ;; Move point to precede feature opening brace.
|
|
|
417 (condition-case ()
|
|
|
418 ;; Move to end of feature but ignore any error if braces are
|
|
|
419 ;; unbalanced. Let the compiler tell the user about this.
|
|
|
420 (forward-sexp)
|
|
|
421 (error nil))
|
|
|
422 (setq rout (objc-feature-normalize rout class)
|
|
|
423 routines (cons rout routines)))))
|
|
|
424 routines)))
|
|
|
425
|
|
|
426 (defun objc-scan-protocol-list ()
|
|
|
427 "Return a list of protocol names following point, delimited by <> and separated by commas.
|
|
|
428 Point may be immediately before or after the '<' which begins the protocol
|
|
|
429 list. Leaves point afer the closing delimiter of the protocol list."
|
|
|
430 (cond ((= (preceding-char) ?\<))
|
|
|
431 ((= (following-char) ?\<)
|
|
|
432 (forward-char 1))
|
|
|
433 (t
|
|
|
434 (error "(objc-scan-protocol-list): Point must precede or follow a '<' delimiter.")))
|
|
|
435 (let ((end (save-excursion (search-forward "\>")))
|
|
|
436 (protocols))
|
|
|
437 (while (re-search-forward objc-identifier end t)
|
|
|
438 (setq protocols (cons (concat "<"
|
|
|
439 (buffer-substring (match-beginning 1)
|
|
|
440 (match-end 1))
|
|
|
441 ">")
|
|
|
442 protocols)))
|
|
|
443 (goto-char end)
|
|
|
444 (nreverse protocols)))
|
|
|
445
|
|
|
446 (defun objc-sort-features (routine-list)
|
|
|
447 (sort routine-list 'objc-feature-lessp))
|
|
|
448
|
|
|
449 (defun objc-to-definition (&optional other-win)
|
|
|
450 "If point is within a declaration, try to move to its definition.
|
|
|
451 With OTHER-WIN non-nil, show it in another window."
|
|
|
452 (interactive)
|
|
|
453 (let ((opoint (point)))
|
|
|
454 (cond
|
|
|
455 ((objc-include-file other-win))
|
|
|
456 ((br-check-for-class (objc-class-decl-p) other-win))
|
|
|
457 ((objc-feature other-win))
|
|
|
458 ((and (goto-char opoint)
|
|
|
459 (br-check-for-class (objc-find-class-name) other-win)))
|
|
|
460 (t (beep)
|
|
|
461 (message
|
|
|
462 "(OO-Browser): Select an Objective-C declaration to move to its definition.")
|
|
|
463 nil))))
|
|
|
464
|
|
|
465 (defun objc-view-protocol (protocol-name)
|
|
|
466 "Display definition of PROTOCOL-NAME for viewing.
|
|
|
467 PROTOCOL-NAME must be a string."
|
|
|
468 (or (string-match "<.*>" protocol-name)
|
|
|
469 (setq protocol-name (concat "<" protocol-name ">")))
|
|
|
470 (let* ((sig (concat objc-default-protocol-class objc-type-tag-separator
|
|
|
471 protocol-name))
|
|
|
472 (feature-path (br-feature-file sig)))
|
|
|
473 (br-to-view-window)
|
|
|
474 (if (br-feature-found-p feature-path sig)
|
|
|
475 (progn (br-major-mode)
|
|
|
476 (setq buffer-read-only t)
|
|
|
477 ;; Force mode-line redisplay
|
|
|
478 (set-buffer-modified-p (buffer-modified-p))
|
|
|
479 (br-to-from-viewer))
|
|
|
480 ;; Protocol not found. Return to original window and signal an error.
|
|
|
481 (br-to-from-viewer)
|
|
|
482 (error "(OO-Browser): No '%s' protocol defined in Environment."
|
|
|
483 protocol-name))))
|
|
|
484
|
|
|
485 ;;; ************************************************************************
|
|
|
486 ;;; Private functions
|
|
|
487 ;;; ************************************************************************
|
|
|
488
|
|
|
489 (defun objc-class-decl-p ()
|
|
|
490 "Return nil unless point is within a class declaration, referenced by another
|
|
|
491 class. Commented declarations also return nil. When value is non-nil, it is
|
|
|
492 the class name from the declaration. Leave point at start of statement for
|
|
|
493 visual clarity."
|
|
|
494 (objc-skip-to-statement)
|
|
|
495 (save-excursion
|
|
|
496 (let ((class))
|
|
|
497 (and (looking-at objc-class-decl)
|
|
|
498 (setq class (buffer-substring (match-beginning objc-class-name-grpn)
|
|
|
499 (match-end objc-class-name-grpn)))
|
|
|
500 (not (c-within-comment-p))
|
|
|
501 (progn (beginning-of-line)
|
|
|
502 (not (looking-at "[ \t]*//")))
|
|
|
503 class))))
|
|
|
504
|
|
|
505 (defun objc-feature (&optional other-win)
|
|
|
506 "Move point to definition of the element given by declaration at point.
|
|
|
507 Return nil if point is not within an element declaration."
|
|
|
508 ;; If '{' follows the feature declaration, then feature is defined right
|
|
|
509 ;; here, within the class definition.
|
|
|
510 (interactive)
|
|
|
511 (cond ((objc-feature-def-p)
|
|
|
512 (recenter 0)
|
|
|
513 t)
|
|
|
514 ;; Now look for feature definition in code (non-header) files.
|
|
|
515 ((objc-feature-decl-p)
|
|
|
516 (let ((class) feature-name signature)
|
|
|
517 (setq signature (buffer-substring (match-beginning 1)
|
|
|
518 (match-end 1)))
|
|
|
519 (save-excursion
|
|
|
520 (if (re-search-backward objc-class-def-regexp nil t)
|
|
|
521 (setq class (buffer-substring
|
|
|
522 (match-beginning objc-class-name-grpn)
|
|
|
523 (match-end objc-class-name-grpn)))))
|
|
|
524 (setq signature (objc-feature-normalize signature class)
|
|
|
525 feature-name (objc-feature-signature-to-name signature))
|
|
|
526 (if (objc-locate-feature feature-name class signature other-win)
|
|
|
527 t
|
|
|
528 (beep)
|
|
|
529 (message "(OO-Browser): No definition for '%s' in '%s'."
|
|
|
530 feature-name (or class "UNKNOWN-CLASS"))
|
|
|
531 t)))))
|
|
|
532
|
|
|
533 (defun objc-feature-decl-p ()
|
|
|
534 "Return t if point is within an Objective-C feature declaration."
|
|
|
535 (save-excursion
|
|
|
536 (beginning-of-line)
|
|
|
537 (looking-at objc-feature-declaration)))
|
|
|
538
|
|
|
539 (defun objc-feature-def-p ()
|
|
|
540 "Return nil unless point is within an element definition.
|
|
|
541 Commented element definitions also return nil."
|
|
|
542 (save-excursion
|
|
|
543 (objc-skip-to-statement)
|
|
|
544 (and (not (c-within-comment-p))
|
|
|
545 (save-excursion (beginning-of-line)
|
|
|
546 (not (looking-at "[ \t]*//")))
|
|
|
547 (not (looking-at objc-class-decl))
|
|
|
548 (looking-at (concat objc-feature-decl-or-def
|
|
|
549 objc-comment-regexp "[{;,]"))
|
|
|
550 (= ?\{ (save-excursion (goto-char (match-end 0))
|
|
|
551 (preceding-char))))))
|
|
|
552
|
|
|
553 (defun objc-feature-partial-name (feature-tag)
|
|
|
554 "Extract the feature name without its class name from FEATURE-TAG."
|
|
|
555 (objc-feature-signature-to-name feature-tag))
|
|
|
556
|
|
|
557 (defun objc-feature-lessp (tag1 tag2)
|
|
|
558 (string-lessp (objc-feature-partial-name tag1)
|
|
|
559 (objc-feature-partial-name tag2)))
|
|
|
560
|
|
|
561 (defun objc-feature-matches (name)
|
|
|
562 "Return an unsorted list of feature tags whose names match in whole to NAME."
|
|
|
563 ;; Ensure match to feature names only.
|
|
|
564 (let ((regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator
|
|
|
565 objc-type-tag-separator br-feature-type-regexp
|
|
|
566 (regexp-quote name) objc-type-tag-separator))
|
|
|
567 (features))
|
|
|
568 (save-excursion
|
|
|
569 (set-buffer
|
|
|
570 (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
571 (goto-char 1)
|
|
|
572 (while (re-search-forward regexp nil t)
|
|
|
573 (save-excursion
|
|
|
574 (setq features (cons (br-feature-current) features))))
|
|
|
575 features)))
|
|
|
576
|
|
|
577 (defun objc-feature-normalize (routine class)
|
|
|
578 (let* ((len (length routine))
|
|
|
579 (normal-feature (make-string len ?\ ))
|
|
|
580 (n 0) (i 0)
|
|
|
581 (space-list '(?\ ?\t ?\n ?\^M))
|
|
|
582 (space-regexp "[ \t\n\^M]+")
|
|
|
583 chr)
|
|
|
584 (while (< i len)
|
|
|
585 (setq chr (aref routine i))
|
|
|
586 (cond
|
|
|
587 ;; Convert sequences of space characters to a single space.
|
|
|
588 ((memq chr space-list)
|
|
|
589 (aset normal-feature n ?\ )
|
|
|
590 (if (string-match space-regexp routine i)
|
|
|
591 (setq i (match-end 0)
|
|
|
592 n (1+ n))
|
|
|
593 (setq i (1+ i)
|
|
|
594 n (1+ n))))
|
|
|
595 ;;
|
|
|
596 ;; Remove // style comments
|
|
|
597 ((and (= chr ?/)
|
|
|
598 (< (1+ i) len)
|
|
|
599 (= (aref routine (1+ i)) ?/))
|
|
|
600 (setq i (+ i 2))
|
|
|
601 (while (and (< i len) (/= (aref routine i) ?\n))
|
|
|
602 (setq i (1+ i))))
|
|
|
603 (t ;; Normal character
|
|
|
604 (aset normal-feature n chr)
|
|
|
605 (setq i (1+ i)
|
|
|
606 n (1+ n)))))
|
|
|
607 (setq normal-feature (substring normal-feature 0 n))
|
|
|
608 (concat class objc-type-tag-separator
|
|
|
609 (objc-feature-signature-to-name normal-feature nil t)
|
|
|
610 objc-type-tag-separator
|
|
|
611 normal-feature)))
|
|
|
612
|
|
|
613 (defun objc-feature-tag-class (feature-signature)
|
|
|
614 "Extract the class name from FEATURE-SIGNATURE."
|
|
|
615 (if (string-match objc-type-tag-separator feature-signature)
|
|
|
616 (substring feature-signature 0 (match-beginning 0))
|
|
|
617 ""))
|
|
|
618
|
|
|
619 (defun objc-feature-tags-lookup (class-list signature ftr-regexp &optional other-win)
|
|
|
620 "Display routine definition derived from CLASS-LIST, matching SIGNATURE (string) and FTR-REGEXP (regexp matching SIGNATURE).
|
|
|
621 Use routine tags table to locate a match. Caller must use 'set-buffer'
|
|
|
622 to restore prior buffer when a match is not found."
|
|
|
623 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
624 (let ((classes class-list)
|
|
|
625 (found-ftr)
|
|
|
626 (class))
|
|
|
627 (if (null class-list)
|
|
|
628 nil
|
|
|
629 (while (and (not found-ftr) classes)
|
|
|
630 (setq class (car classes)
|
|
|
631 found-ftr (br-feature-found-p
|
|
|
632 (br-feature-file signature)
|
|
|
633 ftr-regexp nil other-win t)
|
|
|
634 classes (if found-ftr nil (cdr classes))))
|
|
|
635 (if found-ftr
|
|
|
636 (or class t)
|
|
|
637 (objc-feature-tags-lookup
|
|
|
638 (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl)))
|
|
|
639 class-list))
|
|
|
640 signature
|
|
|
641 ftr-regexp
|
|
|
642 other-win)))))
|
|
|
643
|
|
|
644 (defun objc-files-with-source (class)
|
|
|
645 "Use CLASS to compute set of files that match to an Objective-C source file regexp.
|
|
|
646 Return as a list."
|
|
|
647 (let ((file (if class (br-class-path class) buffer-file-name)))
|
|
|
648 (and file
|
|
|
649 (let* ((src-file-regexp (concat "^" (br-filename-head file)
|
|
|
650 objc-code-file-regexp))
|
|
|
651 (dir (file-name-directory file))
|
|
|
652 (files (directory-files dir nil src-file-regexp)))
|
|
|
653 (mapcar (function (lambda (f) (concat dir f)))
|
|
|
654 files)))))
|
|
|
655
|
|
|
656 (defun objc-find-ancestors-feature (class-list signature &optional other-win)
|
|
|
657 "Scan ancestors of CLASS-LIST and show routine definition matching SIGNATURE."
|
|
|
658 ;; If no class, search for non-element function.
|
|
|
659 (or class-list (setq class-list '(nil)))
|
|
|
660 (let ((obuf (current-buffer))
|
|
|
661 (ftr-regexp (objc-feature-signature-to-regexp signature)))
|
|
|
662 (prog1
|
|
|
663 (if (and br-feature-tags-file
|
|
|
664 (file-exists-p br-feature-tags-file)
|
|
|
665 (file-readable-p br-feature-tags-file))
|
|
|
666 (objc-feature-tags-lookup
|
|
|
667 class-list signature ftr-regexp other-win)
|
|
|
668 ;; Only works if features are in same directory as class def.
|
|
|
669 (objc-scan-ancestors-feature class-list ftr-regexp other-win))
|
|
|
670 (set-buffer obuf))))
|
|
|
671
|
|
|
672 (defun objc-find-class-name ()
|
|
|
673 "Return current word as a potential class name."
|
|
|
674 (save-excursion
|
|
|
675 (let* ((start)
|
|
|
676 (ignore "-+ \t\n;,.<>{}*&\(\)")
|
|
|
677 (pat (concat "^" ignore)))
|
|
|
678 (forward-char 1)
|
|
|
679 (skip-chars-backward ignore)
|
|
|
680 (skip-chars-backward pat)
|
|
|
681 (setq start (point))
|
|
|
682 (skip-chars-forward (concat pat ":"))
|
|
|
683 (buffer-substring start (point)))))
|
|
|
684
|
|
|
685 (defun objc-get-class-name-from-source ()
|
|
|
686 "Return class name from closest class definition preceding point or nil."
|
|
|
687 (let ((opoint (point))
|
|
|
688 (class))
|
|
|
689 (save-excursion
|
|
|
690 (if (re-search-backward objc-class-def-regexp nil t)
|
|
|
691 (progn (setq class (buffer-substring
|
|
|
692 (match-beginning objc-class-name-grpn)
|
|
|
693 (match-end objc-class-name-grpn)))
|
|
|
694 ;; Ensure that declaration occurs within class definition.
|
|
|
695 (forward-list)
|
|
|
696 (and (> (point) opoint) class))))))
|
|
|
697
|
|
|
698 (defun objc-get-feature-tags (routine-file &optional routine-list)
|
|
|
699 "Scan Objective-C ROUTINE-FILE and hold routine tags in 'br-feature-tags-file'.
|
|
|
700 Assume ROUTINE-FILE has already been read into a buffer and that
|
|
|
701 'br-feature-tags-init' has been called. Optional ROUTINE-LIST can be
|
|
|
702 provided so that a non-standard scan function can be used before calling
|
|
|
703 this function."
|
|
|
704 (interactive)
|
|
|
705 (let ((obuf (current-buffer)))
|
|
|
706 (setq routine-list
|
|
|
707 (objc-sort-features
|
|
|
708 (or routine-list (objc-scan-features))))
|
|
|
709 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
710 (goto-char 1)
|
|
|
711 ;; Delete any prior routine tags associated with routine-file
|
|
|
712 (if (search-forward routine-file nil 'end)
|
|
|
713 (progn (forward-line -1)
|
|
|
714 (let ((start (point)))
|
|
|
715 (search-forward "\^L" nil 'end 2)
|
|
|
716 (backward-char 1)
|
|
|
717 (delete-region start (point))
|
|
|
718 )))
|
|
|
719 (if routine-list
|
|
|
720 (progn (insert "\^L\n" routine-file "\n")
|
|
|
721 (mapcar (function (lambda (tag) (insert tag "\n")))
|
|
|
722 routine-list)))
|
|
|
723 (set-buffer obuf)))
|
|
|
724
|
|
|
725 (defun objc-include-file (&optional other-win)
|
|
|
726 "If point is on an include file line, try to display file.
|
|
|
727 Return non-nil iff an include file line, even if file is not found.
|
|
|
728 Look for include file in 'objc-cpp-include-dirs' and in directory list
|
|
|
729 'objc-include-dirs'."
|
|
|
730 (let ((opoint (point)))
|
|
|
731 (beginning-of-line)
|
|
|
732 (if (looking-at objc-include-regexp)
|
|
|
733 (let ((incl-type (string-to-char
|
|
|
734 (buffer-substring
|
|
|
735 (match-beginning objc-include-type-grpn)
|
|
|
736 (1+ (match-beginning objc-include-type-grpn)))))
|
|
|
737 (file (buffer-substring
|
|
|
738 (match-beginning objc-include-file-grpn)
|
|
|
739 (match-end objc-include-file-grpn)))
|
|
|
740 (path)
|
|
|
741 (dir-list objc-include-dirs)
|
|
|
742 (found))
|
|
|
743 (goto-char opoint)
|
|
|
744 (setq dir-list (if (= incl-type ?\<)
|
|
|
745 (append dir-list objc-cpp-include-dirs)
|
|
|
746 (cons (file-name-directory buffer-file-name)
|
|
|
747 dir-list)))
|
|
|
748 (while dir-list
|
|
|
749 (setq path (concat (car dir-list) file)
|
|
|
750 dir-list (if (setq found (file-exists-p path))
|
|
|
751 nil
|
|
|
752 (cdr dir-list))))
|
|
|
753 ;;
|
|
|
754 ;; If not found in normal include dirs, check all Env paths also.
|
|
|
755 ;;
|
|
|
756 (if (not found)
|
|
|
757 (let ((paths (delq nil (hash-map 'cdr br-paths-htable))))
|
|
|
758 (while paths
|
|
|
759 (setq path (car paths))
|
|
|
760 (if (string-equal (file-name-nondirectory path) file)
|
|
|
761 (setq found t paths nil)
|
|
|
762 (setq paths (cdr paths))))))
|
|
|
763 ;;
|
|
|
764 ;; If found, display file
|
|
|
765 ;;
|
|
|
766 (if found
|
|
|
767 (if (file-readable-p path)
|
|
|
768 (progn
|
|
|
769 (funcall br-edit-file-function path other-win)
|
|
|
770 (if (not (fboundp 'br-lang-mode))
|
|
|
771 (objc-mode-setup))
|
|
|
772 (br-major-mode))
|
|
|
773 (beep)
|
|
|
774 (message "(OO-Browser): Include file '%s' unreadable." path))
|
|
|
775 (beep)
|
|
|
776 (message "(OO-Browser): Include file '%s' not found." file))
|
|
|
777 path)
|
|
|
778 (goto-char opoint)
|
|
|
779 nil)))
|
|
|
780
|
|
|
781 (defun objc-locate-feature (ftr class signature &optional other-win)
|
|
|
782 ;; 'class' may = nil, implying non-element function
|
|
|
783 (let ((def-class))
|
|
|
784 (if (and signature
|
|
|
785 (setq def-class
|
|
|
786 (objc-find-ancestors-feature (list class)
|
|
|
787 signature other-win)))
|
|
|
788 (progn (if (and class (not (equal class def-class)))
|
|
|
789 (message
|
|
|
790 "Element `%s` of class '%s' inherited from class '%s'."
|
|
|
791 ftr class def-class))
|
|
|
792 t))))
|
|
|
793
|
|
|
794 (defun objc-scan-ancestors-feature (class-list ftr-regexp &optional other-win)
|
|
|
795 "Display routine definition derived from CLASS-LIST, matching FTR-REGEXP.
|
|
|
796 Scan files with same base name as class file."
|
|
|
797 (let ((classes class-list)
|
|
|
798 (found-ftr)
|
|
|
799 (code-def-files)
|
|
|
800 (file)
|
|
|
801 (class))
|
|
|
802 (if (null class-list)
|
|
|
803 nil
|
|
|
804 (while (and (not found-ftr) classes)
|
|
|
805 (setq class (car classes)
|
|
|
806 code-def-files (objc-files-with-source class))
|
|
|
807 (while (and (setq file (car code-def-files))
|
|
|
808 (not (setq found-ftr
|
|
|
809 (br-feature-found-p file ftr-regexp
|
|
|
810 nil other-win t))))
|
|
|
811 (setq code-def-files (cdr code-def-files)))
|
|
|
812 (setq classes (if found-ftr nil (cdr classes))))
|
|
|
813 (if found-ftr
|
|
|
814 (or class t)
|
|
|
815 (objc-scan-ancestors-feature
|
|
|
816 (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl)))
|
|
|
817 class-list))
|
|
|
818 ftr-regexp)))))
|
|
|
819
|
|
|
820 (defun objc-skip-past-comments ()
|
|
|
821 "Skip over comments immediately following point."
|
|
|
822 (skip-chars-forward " \t\n")
|
|
|
823 (while
|
|
|
824 (cond ((looking-at "//")
|
|
|
825 (equal (forward-line 1) 0))
|
|
|
826 ((looking-at "/\\*")
|
|
|
827 (re-search-forward "\\*/" nil t))
|
|
|
828 (t nil))))
|
|
|
829
|
|
|
830 (defun objc-skip-to-statement ()
|
|
|
831 (if (re-search-backward "\\(^\\|[;{}]\\)[ \t]*" nil t)
|
|
|
832 (progn (goto-char (match-end 0))
|
|
|
833 (skip-chars-forward " \t")
|
|
|
834 t)))
|
|
|
835
|
|
|
836 ;;; ************************************************************************
|
|
|
837 ;;; Private variables
|
|
|
838 ;;; ************************************************************************
|
|
|
839
|
|
|
840 (defconst objc-code-file-regexp ".\\.[cmCM]$"
|
|
|
841 "Regular expression matching a unique part of Objective-C source (non-header) file name and no others.")
|
|
|
842
|
|
|
843 (defconst objc-include-regexp
|
|
|
844 "[ \t/*]*#[ \t]*\\(import\\|include\\)[ \t]+\\([\"<]\\)\\([^\">]+\\)[\">]"
|
|
|
845 "Regexp to match to Objective-C include file lines.
|
|
|
846 File name is grouping 'objc-include-file-grpn'. Type of include,
|
|
|
847 user-specified via double quote, or system-related starting with `<' is given
|
|
|
848 by grouping 'objc-include-type-grpn'.")
|
|
|
849
|
|
|
850 (defconst objc-include-type-grpn 2)
|
|
|
851 (defconst objc-include-file-grpn 3)
|
|
|
852
|
|
|
853 (defconst objc-type-def-modifier
|
|
|
854 "\\(auto\\|const\\|inline\\|register\\|static\\|typedef\\)")
|
|
|
855
|
|
|
856 (defconst objc-func-identifier (concat
|
|
|
857 "[_a-zA-Z][^][ \t:;.,~{}()]*")
|
|
|
858 "Regular expression matching an Objective-C function name.")
|
|
|
859
|
|
|
860 (defconst objc-feature-decl-or-def
|
|
|
861 "[-+]\\([^\]\[{};`'\"/|?,!.#$%^=+-]+\\)"
|
|
|
862 "Regexp matching an Objective-C feature declaration or definition.
|
|
|
863 Feature name is group 1.")
|
|
|
864
|
|
|
865 (defconst objc-feature-name-grpn 1)
|
|
|
866
|
|
|
867 (defconst objc-comment-regexp "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*")
|
|
|
868
|
|
|
869 (defconst objc-routine-def (concat "^" objc-feature-decl-or-def
|
|
|
870 objc-comment-regexp "{"))
|
|
|
871
|
|
|
872 (defconst objc-feature-declaration
|
|
|
873 (concat "^[ \t]*\\(" objc-feature-decl-or-def "\\)" objc-comment-regexp ";"))
|
|
|
874
|
|
|
875 (defconst objc-class-decl
|
|
|
876 (concat objc-class-name-before objc-identifier "[ \t]*")
|
|
|
877 "Regexp matching an Objective-C class declaration.
|
|
|
878 Class name is grouping 'objc-class-name-grpn'.")
|
|
|
879
|
|
|
880 (defconst objc-class-name-grpn 2)
|
|
|
881
|
|
|
882 (defconst objc-arg-identifier (concat
|
|
|
883 "[_a-zA-Z][" objc-identifier-chars "]*")
|
|
|
884 "Regular expression matching an Objective-C function argument identifier.")
|
|
|
885
|
|
|
886 (defconst objc-name-part-prefix
|
|
|
887 "[ \t\n]*\\(([^\)]+)[ \t\n]*\\)?")
|
|
|
888
|
|
|
889 (defconst objc-name-part
|
|
|
890 (concat objc-name-part-prefix objc-identifier "?"))
|
|
|
891
|
|
|
892 (defconst objc-name-sep "[ \t\n]*\\([:;{]\\)")
|
|
|
893
|
|
|
894 (defconst objc-type-sep "\\([ \t\n;{]\\)")
|
|
|
895
|
|
|
896 (defconst objc-name-part-type 1)
|
|
|
897 (defconst objc-name-part-id 2)
|
|
|
898 (defconst objc-name-part-sep 3)
|
|
|
899
|
|
|
900 (provide 'br-objc-ft)
|
