Mercurial > hg > xemacs-beta
comparison lisp/oobr/br-objc-ft.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-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) |