Mercurial > hg > xemacs-beta

comparison lisp/oobr/br-objc-ft.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 4be1180a9e89
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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: InfoDock Associates 9 ;; ORG: Motorola Inc.
10 ;; 10 ;;
11 ;; ORIG-DATE: 03-Oct-90 11 ;; ORIG-DATE: 03-Oct-90
12 ;; LAST-MOD: 31-Oct-96 at 17:03:48 by Bob Weiner 12 ;; LAST-MOD: 5-May-95 at 15:57:14 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1990-1996 Free Software Foundation, Inc. 14 ;; Copyright (C) 1990-1995 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 (regexp-quote ftr-name))) 107 (objc-feature-matches 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))
177 151
178 (defun objc-feature-name-to-regexp (name) 152 (defun objc-feature-name-to-regexp (name)
179 "Converts feature NAME into a regular expression matching the feature's name tag." 153 "Converts feature NAME into a regular expression matching the feature's name tag."
180 (cond 154 (cond
181 ;; 155 ;;
314 (if (= ?{ (aref pat (1- (length pat)))) 288 (if (= ?{ (aref pat (1- (length pat))))
315 (setq pat (concat (substring pat 0 -1) 289 (setq pat (concat (substring pat 0 -1)
316 "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{")) 290 "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{"))
317 pat))))) 291 pat)))))
318 292
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
325 (defun objc-feature-tree-command-p (class-or-signature) 293 (defun objc-feature-tree-command-p (class-or-signature)
326 "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil." 294 "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil."
327 (if (br-in-browser) (br-to-view-window)) 295 (if (br-in-browser) (br-to-view-window))
328 (br-feature-found-p (br-feature-file class-or-signature) 296 (br-feature-found-p (br-feature-file class-or-signature)
329 class-or-signature)) 297 class-or-signature))
348 (setq categories (cons (br-feature-current) categories))) 316 (setq categories (cons (br-feature-current) categories)))
349 (set-buffer obuf) 317 (set-buffer obuf)
350 (objc-sort-features (nreverse categories)))))) 318 (objc-sort-features (nreverse categories))))))
351 319
352 (defun objc-list-features (class &optional indent) 320 (defun objc-list-features (class &optional indent)
353 "Return sorted list of Objective-C feature tags lexically defined in CLASS. 321 "Return sorted list of Objective-C features lexically defined in CLASS."
354 Optional INDENT is unused but is required for multi-language OO-Browser conformance." 322 (let ((obuf (current-buffer))
355 (objc-sort-features 323 (features)
356 (nreverse (objc-feature-map-class-tags 'br-feature-current class)))) 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))))
357 341
358 (defun objc-list-protocols (class) 342 (defun objc-list-protocols (class)
359 "Return sorted list of Objective-C CLASS protocols." 343 "Return sorted list of Objective-C CLASS protocols."
360 (let ((obuf (current-buffer)) 344 (let ((obuf (current-buffer))
361 (protocols) 345 (protocols)
564 (looking-at (concat objc-feature-decl-or-def 548 (looking-at (concat objc-feature-decl-or-def
565 objc-comment-regexp "[{;,]")) 549 objc-comment-regexp "[{;,]"))
566 (= ?\{ (save-excursion (goto-char (match-end 0)) 550 (= ?\{ (save-excursion (goto-char (match-end 0))
567 (preceding-char)))))) 551 (preceding-char))))))
568 552
569 (defun objc-feature-display (class-list signature ftr-regexp &optional other-win) 553 (defun objc-feature-partial-name (feature-tag)
570 "Display routine definition derived from CLASS-LIST, matching SIGNATURE (string) and FTR-REGEXP (regexp matching SIGNATURE). 554 "Extract the feature name without its class name from FEATURE-TAG."
571 Use routine tags table to locate a match. Caller must use 'set-buffer' 555 (objc-feature-signature-to-name feature-tag))
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)))))
593 556
594 (defun objc-feature-lessp (tag1 tag2) 557 (defun objc-feature-lessp (tag1 tag2)
595 (string-lessp (objc-feature-partial-name tag1) 558 (string-lessp (objc-feature-partial-name tag1)
596 (objc-feature-partial-name tag2))) 559 (objc-feature-partial-name tag2)))
597 560
598 (defun objc-feature-map-tags (function regexp) 561 (defun objc-feature-matches (name)
599 "Apply FUNCTION to all current feature tags that match REGEXP and return a list of the results. 562 "Return an unsorted list of feature tags whose names match in whole to NAME."
600 Feature tags come from the file named by br-feature-tags-file." 563 ;; Ensure match to feature names only.
601 (let ((identifier-chars (concat "[" objc-identifier-chars "]*")) 564 (let ((regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator
602 (results)) 565 objc-type-tag-separator br-feature-type-regexp
603 (setq regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator 566 (regexp-quote name) objc-type-tag-separator))
604 objc-type-tag-separator br-feature-type-regexp 567 (features))
605 regexp objc-type-tag-separator))
606 ;; Ensure match to feature names only; also handle "^" and "$" meta-chars
607 (save-excursion 568 (save-excursion
608 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) 569 (set-buffer
570 (funcall br-find-file-noselect-function br-feature-tags-file))
609 (goto-char 1) 571 (goto-char 1)
610 (while (re-search-forward regexp nil t) 572 (while (re-search-forward regexp nil t)
611 (setq results (cons (funcall function) results)))) 573 (save-excursion
612 results)) 574 (setq features (cons (br-feature-current) features))))
613 575 features)))
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))
619 576
620 (defun objc-feature-normalize (routine class) 577 (defun objc-feature-normalize (routine class)
621 (let* ((len (length routine)) 578 (let* ((len (length routine))
622 (normal-feature (make-string len ?\ )) 579 (normal-feature (make-string len ?\ ))
623 (n 0) (i 0) 580 (n 0) (i 0)
651 (concat class objc-type-tag-separator 608 (concat class objc-type-tag-separator
652 (objc-feature-signature-to-name normal-feature nil t) 609 (objc-feature-signature-to-name normal-feature nil t)
653 objc-type-tag-separator 610 objc-type-tag-separator
654 normal-feature))) 611 normal-feature)))
655 612
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
660 (defun objc-feature-tag-class (feature-signature) 613 (defun objc-feature-tag-class (feature-signature)
661 "Extract the class name from FEATURE-SIGNATURE." 614 "Extract the class name from FEATURE-SIGNATURE."
662 (if (string-match objc-type-tag-separator feature-signature) 615 (if (string-match objc-type-tag-separator feature-signature)
663 (substring feature-signature 0 (match-beginning 0)) 616 (substring feature-signature 0 (match-beginning 0))
664 "")) 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)))))
665 643
666 (defun objc-files-with-source (class) 644 (defun objc-files-with-source (class)
667 "Use CLASS to compute set of files that match to an Objective-C source file regexp. 645 "Use CLASS to compute set of files that match to an Objective-C source file regexp.
668 Return as a list." 646 Return as a list."
669 (let ((file (if class (br-class-path class) buffer-file-name))) 647 (let ((file (if class (br-class-path class) buffer-file-name)))
683 (ftr-regexp (objc-feature-signature-to-regexp signature))) 661 (ftr-regexp (objc-feature-signature-to-regexp signature)))
684 (prog1 662 (prog1
685 (if (and br-feature-tags-file 663 (if (and br-feature-tags-file
686 (file-exists-p br-feature-tags-file) 664 (file-exists-p br-feature-tags-file)
687 (file-readable-p br-feature-tags-file)) 665 (file-readable-p br-feature-tags-file))
688 (objc-feature-display 666 (objc-feature-tags-lookup
689 class-list signature ftr-regexp other-win) 667 class-list signature ftr-regexp other-win)
690 ;; Only works if features are in same directory as class def. 668 ;; Only works if features are in same directory as class def.
691 (objc-scan-ancestors-feature class-list ftr-regexp other-win)) 669 (objc-scan-ancestors-feature class-list ftr-regexp other-win))
692 (set-buffer obuf)))) 670 (set-buffer obuf))))
693 671