Mercurial > hg > xemacs-beta

comparison lisp/oobr/br-objc-ft.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
4 ;; SUMMARY: Objective-C OO-Browser class and feature functions. 4 ;; SUMMARY: Objective-C OO-Browser class and feature functions.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: c, oop, tools 6 ;; KEYWORDS: c, oop, tools
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola Inc. 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 03-Oct-90 11 ;; ORIG-DATE: 03-Oct-90
12 ;; LAST-MOD: 5-May-95 at 15:57:14 by Bob Weiner 12 ;; LAST-MOD: 31-Oct-96 at 17:03:48 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1990-1995 Free Software Foundation, Inc. 14 ;; Copyright (C) 1990-1996 Free Software Foundation, Inc.
15 ;; See the file BR-COPY for license information. 15 ;; See the file BR-COPY for license information.
16 ;; 16 ;;
17 ;; This file is part of the OO-Browser. 17 ;; This file is part of the OO-Browser.
18 ;; 18 ;;
19 ;; DESCRIPTION: 19 ;; DESCRIPTION:
102 (concat objc-class-name-before (objc-class-definition-name class) 102 (concat objc-class-name-before (objc-class-definition-name class)
103 objc-class-name-after)) 103 objc-class-name-after))
104 104
105 (defun objc-feature-implementors (ftr-name) 105 (defun objc-feature-implementors (ftr-name)
106 "Return unsorted list of Objective-C feature tags which implement FTR-NAME." 106 "Return unsorted list of Objective-C feature tags which implement FTR-NAME."
107 (objc-feature-matches ftr-name)) 107 (objc-feature-matches (regexp-quote ftr-name)))
108 108
109 (defun objc-feature-locate-p (feature-tag &optional regexp-flag) 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. 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 111 Assumes caller has moved point to the beginning of the buffer or to the point
112 of desired search start. 112 of desired search start.
146 (skip-chars-forward " \t\n") 146 (skip-chars-forward " \t\n")
147 (objc-to-comments-begin) 147 (objc-to-comments-begin)
148 (recenter 0) 148 (recenter 0)
149 (goto-char start) 149 (goto-char start)
150 t)))) 150 t))))
151
152 (defun objc-feature-map-class-tags (function class)
153 "Apply FUNCTION to all feature tags from CLASS and return a list of the results.
154 Feature tags come from the file named by br-feature-tags-file."
155 (let ((obuf (current-buffer))
156 (class-tag (concat "\n" class objc-type-tag-separator))
157 (results)
158 search-function)
159 (if (= (aref class 0) ?\[)
160 ;; Default class of protocols or categories. Use a string match
161 ;; for speed.
162 (setq search-function 'search-forward
163 class-tag (concat "\n" class objc-type-tag-separator))
164 (setq search-function 're-search-forward
165 class-tag
166 ;; Include methods defined in any of the class' categories.
167 (concat "^" class "\\(([^\)]*)\\)?" objc-type-tag-separator)))
168 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
169 (goto-char 1)
170 (while (funcall search-function class-tag nil t)
171 (setq results (cons (funcall function) results))
172 ;; Might have deleted current tag and would miss next tag unless point
173 ;; is moved backwards.
174 (backward-char))
175 (set-buffer obuf)
176 results))
151 177
152 (defun objc-feature-name-to-regexp (name) 178 (defun objc-feature-name-to-regexp (name)
153 "Converts feature NAME into a regular expression matching the feature's name tag." 179 "Converts feature NAME into a regular expression matching the feature's name tag."
154 (cond 180 (cond
155 ;; 181 ;;
288 (if (= ?{ (aref pat (1- (length pat)))) 314 (if (= ?{ (aref pat (1- (length pat))))
289 (setq pat (concat (substring pat 0 -1) 315 (setq pat (concat (substring pat 0 -1)
290 "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{")) 316 "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{"))
291 pat))))) 317 pat)))))
292 318
319 (defun objc-feature-tag-regexp (class feature-name)
320 "Return a regexp that matches to the feature tag entry for CLASS' FEATURE-NAME."
321 (concat "^" (regexp-quote class) objc-type-tag-separator
322 br-feature-type-regexp " "
323 (regexp-quote feature-name) "\\(" objc-type-tag-separator "\\|\\'\\)"))
324
293 (defun objc-feature-tree-command-p (class-or-signature) 325 (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." 326 "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil."
295 (if (br-in-browser) (br-to-view-window)) 327 (if (br-in-browser) (br-to-view-window))
296 (br-feature-found-p (br-feature-file class-or-signature) 328 (br-feature-found-p (br-feature-file class-or-signature)
297 class-or-signature)) 329 class-or-signature))
316 (setq categories (cons (br-feature-current) categories))) 348 (setq categories (cons (br-feature-current) categories)))
317 (set-buffer obuf) 349 (set-buffer obuf)
318 (objc-sort-features (nreverse categories)))))) 350 (objc-sort-features (nreverse categories))))))
319 351
320 (defun objc-list-features (class &optional indent) 352 (defun objc-list-features (class &optional indent)
321 "Return sorted list of Objective-C features lexically defined in CLASS." 353 "Return sorted list of Objective-C feature tags lexically defined in CLASS.
322 (let ((obuf (current-buffer)) 354 Optional INDENT is unused but is required for multi-language OO-Browser conformance."
323 (features) 355 (objc-sort-features
324 class-tag 356 (nreverse (objc-feature-map-class-tags 'br-feature-current class))))
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 357
342 (defun objc-list-protocols (class) 358 (defun objc-list-protocols (class)
343 "Return sorted list of Objective-C CLASS protocols." 359 "Return sorted list of Objective-C CLASS protocols."
344 (let ((obuf (current-buffer)) 360 (let ((obuf (current-buffer))
345 (protocols) 361 (protocols)
548 (looking-at (concat objc-feature-decl-or-def 564 (looking-at (concat objc-feature-decl-or-def
549 objc-comment-regexp "[{;,]")) 565 objc-comment-regexp "[{;,]"))
550 (= ?\{ (save-excursion (goto-char (match-end 0)) 566 (= ?\{ (save-excursion (goto-char (match-end 0))
551 (preceding-char)))))) 567 (preceding-char))))))
552 568
553 (defun objc-feature-partial-name (feature-tag) 569 (defun objc-feature-display (class-list signature ftr-regexp &optional other-win)
554 "Extract the feature name without its class name from FEATURE-TAG." 570 "Display routine definition derived from CLASS-LIST, matching SIGNATURE (string) and FTR-REGEXP (regexp matching SIGNATURE).
555 (objc-feature-signature-to-name feature-tag)) 571 Use routine tags table to locate a match. Caller must use 'set-buffer'
572 to restore prior buffer when a match is not found."
573 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
574 (let ((classes class-list)
575 (found-ftr)
576 (class))
577 (if (null class-list)
578 nil
579 (while (and (not found-ftr) classes)
580 (setq class (car classes)
581 found-ftr (br-feature-found-p
582 (br-feature-file signature)
583 ftr-regexp nil other-win t)
584 classes (if found-ftr nil (cdr classes))))
585 (if found-ftr
586 (or class t)
587 (objc-feature-display
588 (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl)))
589 class-list))
590 signature
591 ftr-regexp
592 other-win)))))
556 593
557 (defun objc-feature-lessp (tag1 tag2) 594 (defun objc-feature-lessp (tag1 tag2)
558 (string-lessp (objc-feature-partial-name tag1) 595 (string-lessp (objc-feature-partial-name tag1)
559 (objc-feature-partial-name tag2))) 596 (objc-feature-partial-name tag2)))
560 597
561 (defun objc-feature-matches (name) 598 (defun objc-feature-map-tags (function regexp)
562 "Return an unsorted list of feature tags whose names match in whole to NAME." 599 "Apply FUNCTION to all current feature tags that match REGEXP and return a list of the results.
563 ;; Ensure match to feature names only. 600 Feature tags come from the file named by br-feature-tags-file."
564 (let ((regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator 601 (let ((identifier-chars (concat "[" objc-identifier-chars "]*"))
565 objc-type-tag-separator br-feature-type-regexp 602 (results))
566 (regexp-quote name) objc-type-tag-separator)) 603 (setq regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator
567 (features)) 604 objc-type-tag-separator br-feature-type-regexp
605 regexp objc-type-tag-separator))
606 ;; Ensure match to feature names only; also handle "^" and "$" meta-chars
568 (save-excursion 607 (save-excursion
569 (set-buffer 608 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
570 (funcall br-find-file-noselect-function br-feature-tags-file))
571 (goto-char 1) 609 (goto-char 1)
572 (while (re-search-forward regexp nil t) 610 (while (re-search-forward regexp nil t)
573 (save-excursion 611 (setq results (cons (funcall function) results))))
574 (setq features (cons (br-feature-current) features)))) 612 results))
575 features))) 613
614 (defun objc-feature-matches (regexp)
615 "Return an unsorted list of feature tags whose names match in part or whole to REGEXP.
616 ^ and $ characters may be used to match to the beginning and end of a feature name,
617 respectively."
618 (objc-feature-map-tags 'br-feature-current regexp))
576 619
577 (defun objc-feature-normalize (routine class) 620 (defun objc-feature-normalize (routine class)
578 (let* ((len (length routine)) 621 (let* ((len (length routine))
579 (normal-feature (make-string len ?\ )) 622 (normal-feature (make-string len ?\ ))
580 (n 0) (i 0) 623 (n 0) (i 0)
608 (concat class objc-type-tag-separator 651 (concat class objc-type-tag-separator
609 (objc-feature-signature-to-name normal-feature nil t) 652 (objc-feature-signature-to-name normal-feature nil t)
610 objc-type-tag-separator 653 objc-type-tag-separator
611 normal-feature))) 654 normal-feature)))
612 655
656 (defun objc-feature-partial-name (feature-tag)
657 "Extract the feature name without its class name from FEATURE-TAG."
658 (objc-feature-signature-to-name feature-tag))
659
613 (defun objc-feature-tag-class (feature-signature) 660 (defun objc-feature-tag-class (feature-signature)
614 "Extract the class name from FEATURE-SIGNATURE." 661 "Extract the class name from FEATURE-SIGNATURE."
615 (if (string-match objc-type-tag-separator feature-signature) 662 (if (string-match objc-type-tag-separator feature-signature)
616 (substring feature-signature 0 (match-beginning 0)) 663 (substring feature-signature 0 (match-beginning 0))
617 "")) 664 ""))
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 665
644 (defun objc-files-with-source (class) 666 (defun objc-files-with-source (class)
645 "Use CLASS to compute set of files that match to an Objective-C source file regexp. 667 "Use CLASS to compute set of files that match to an Objective-C source file regexp.
646 Return as a list." 668 Return as a list."
647 (let ((file (if class (br-class-path class) buffer-file-name))) 669 (let ((file (if class (br-class-path class) buffer-file-name)))
661 (ftr-regexp (objc-feature-signature-to-regexp signature))) 683 (ftr-regexp (objc-feature-signature-to-regexp signature)))
662 (prog1 684 (prog1
663 (if (and br-feature-tags-file 685 (if (and br-feature-tags-file
664 (file-exists-p br-feature-tags-file) 686 (file-exists-p br-feature-tags-file)
665 (file-readable-p br-feature-tags-file)) 687 (file-readable-p br-feature-tags-file))
666 (objc-feature-tags-lookup 688 (objc-feature-display
667 class-list signature ftr-regexp other-win) 689 class-list signature ftr-regexp other-win)
668 ;; Only works if features are in same directory as class def. 690 ;; Only works if features are in same directory as class def.
669 (objc-scan-ancestors-feature class-list ftr-regexp other-win)) 691 (objc-scan-ancestors-feature class-list ftr-regexp other-win))
670 (set-buffer obuf)))) 692 (set-buffer obuf))))
671 693