Mercurial > hg > xemacs-beta
diff lisp/oobr/br-objc-ft.el @ 24:4103f0995bd7 r19-15b95
Import from CVS: tag r19-15b95
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:51:03 +0200 |
parents | 376386a54a3c |
children | 131b0175ea99 |
line wrap: on
line diff
--- a/lisp/oobr/br-objc-ft.el Mon Aug 13 08:50:31 2007 +0200 +++ b/lisp/oobr/br-objc-ft.el Mon Aug 13 08:51:03 2007 +0200 @@ -6,12 +6,12 @@ ;; KEYWORDS: c, oop, tools ;; ;; AUTHOR: Bob Weiner -;; ORG: Motorola Inc. +;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 03-Oct-90 -;; LAST-MOD: 5-May-95 at 15:57:14 by Bob Weiner +;; LAST-MOD: 31-Oct-96 at 17:03:48 by Bob Weiner ;; -;; Copyright (C) 1990-1995 Free Software Foundation, Inc. +;; Copyright (C) 1990-1996 Free Software Foundation, Inc. ;; See the file BR-COPY for license information. ;; ;; This file is part of the OO-Browser. @@ -104,7 +104,7 @@ (defun objc-feature-implementors (ftr-name) "Return unsorted list of Objective-C feature tags which implement FTR-NAME." - (objc-feature-matches ftr-name)) + (objc-feature-matches (regexp-quote ftr-name))) (defun objc-feature-locate-p (feature-tag &optional regexp-flag) "Leaves point at the start of FEATURE-TAG's definition in the current buffer. @@ -149,6 +149,32 @@ (goto-char start) t)))) +(defun objc-feature-map-class-tags (function class) + "Apply FUNCTION to all feature tags from CLASS and return a list of the results. +Feature tags come from the file named by br-feature-tags-file." + (let ((obuf (current-buffer)) + (class-tag (concat "\n" class objc-type-tag-separator)) + (results) + search-function) + (if (= (aref class 0) ?\[) + ;; Default class of protocols or categories. Use a string match + ;; for speed. + (setq search-function 'search-forward + class-tag (concat "\n" class objc-type-tag-separator)) + (setq search-function 're-search-forward + class-tag + ;; Include methods defined in any of the class' categories. + (concat "^" class "\\(([^\)]*)\\)?" objc-type-tag-separator))) + (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) + (goto-char 1) + (while (funcall search-function class-tag nil t) + (setq results (cons (funcall function) results)) + ;; Might have deleted current tag and would miss next tag unless point + ;; is moved backwards. + (backward-char)) + (set-buffer obuf) + results)) + (defun objc-feature-name-to-regexp (name) "Converts feature NAME into a regular expression matching the feature's name tag." (cond @@ -290,6 +316,12 @@ "\\([ \t\n]*//.*[\n]\\)*[ \t\n]*{")) pat))))) +(defun objc-feature-tag-regexp (class feature-name) + "Return a regexp that matches to the feature tag entry for CLASS' FEATURE-NAME." + (concat "^" (regexp-quote class) objc-type-tag-separator + br-feature-type-regexp " " + (regexp-quote feature-name) "\\(" objc-type-tag-separator "\\|\\'\\)")) + (defun objc-feature-tree-command-p (class-or-signature) "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil." (if (br-in-browser) (br-to-view-window)) @@ -318,26 +350,10 @@ (objc-sort-features (nreverse categories)))))) (defun objc-list-features (class &optional indent) - "Return sorted list of Objective-C features lexically defined in CLASS." - (let ((obuf (current-buffer)) - (features) - class-tag - search-function) - (if (= (aref class 0) ?\[) - ;; Default class of protocols or categories. Use a string match - ;; for speed. - (setq search-function 'search-forward - class-tag (concat "\n" class objc-type-tag-separator)) - (setq search-function 're-search-forward - class-tag - ;; Include methods defined in any of the class' categories. - (concat "^" class "\\(([^\)]*)\\)?" objc-type-tag-separator))) - (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) - (goto-char 1) - (while (funcall search-function class-tag nil t) - (setq features (cons (br-feature-current) features))) - (set-buffer obuf) - (objc-sort-features (nreverse features)))) + "Return sorted list of Objective-C feature tags lexically defined in CLASS. +Optional INDENT is unused but is required for multi-language OO-Browser conformance." + (objc-sort-features + (nreverse (objc-feature-map-class-tags 'br-feature-current class)))) (defun objc-list-protocols (class) "Return sorted list of Objective-C CLASS protocols." @@ -550,29 +566,56 @@ (= ?\{ (save-excursion (goto-char (match-end 0)) (preceding-char)))))) -(defun objc-feature-partial-name (feature-tag) - "Extract the feature name without its class name from FEATURE-TAG." - (objc-feature-signature-to-name feature-tag)) +(defun objc-feature-display (class-list signature ftr-regexp &optional other-win) + "Display routine definition derived from CLASS-LIST, matching SIGNATURE (string) and FTR-REGEXP (regexp matching SIGNATURE). +Use routine tags table to locate a match. Caller must use 'set-buffer' +to restore prior buffer when a match is not found." + (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) + (let ((classes class-list) + (found-ftr) + (class)) + (if (null class-list) + nil + (while (and (not found-ftr) classes) + (setq class (car classes) + found-ftr (br-feature-found-p + (br-feature-file signature) + ftr-regexp nil other-win t) + classes (if found-ftr nil (cdr classes)))) + (if found-ftr + (or class t) + (objc-feature-display + (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl))) + class-list)) + signature + ftr-regexp + other-win))))) (defun objc-feature-lessp (tag1 tag2) (string-lessp (objc-feature-partial-name tag1) (objc-feature-partial-name tag2))) -(defun objc-feature-matches (name) - "Return an unsorted list of feature tags whose names match in whole to NAME." - ;; Ensure match to feature names only. - (let ((regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator - objc-type-tag-separator br-feature-type-regexp - (regexp-quote name) objc-type-tag-separator)) - (features)) +(defun objc-feature-map-tags (function regexp) + "Apply FUNCTION to all current feature tags that match REGEXP and return a list of the results. +Feature tags come from the file named by br-feature-tags-file." + (let ((identifier-chars (concat "[" objc-identifier-chars "]*")) + (results)) + (setq regexp (format "^[^%s \n]+%s%s %s%s" objc-type-tag-separator + objc-type-tag-separator br-feature-type-regexp + regexp objc-type-tag-separator)) + ;; Ensure match to feature names only; also handle "^" and "$" meta-chars (save-excursion - (set-buffer - (funcall br-find-file-noselect-function br-feature-tags-file)) + (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) (goto-char 1) (while (re-search-forward regexp nil t) - (save-excursion - (setq features (cons (br-feature-current) features)))) - features))) + (setq results (cons (funcall function) results)))) + results)) + +(defun objc-feature-matches (regexp) + "Return an unsorted list of feature tags whose names match in part or whole to REGEXP. +^ and $ characters may be used to match to the beginning and end of a feature name, +respectively." + (objc-feature-map-tags 'br-feature-current regexp)) (defun objc-feature-normalize (routine class) (let* ((len (length routine)) @@ -610,37 +653,16 @@ objc-type-tag-separator normal-feature))) +(defun objc-feature-partial-name (feature-tag) + "Extract the feature name without its class name from FEATURE-TAG." + (objc-feature-signature-to-name feature-tag)) + (defun objc-feature-tag-class (feature-signature) "Extract the class name from FEATURE-SIGNATURE." (if (string-match objc-type-tag-separator feature-signature) (substring feature-signature 0 (match-beginning 0)) "")) -(defun objc-feature-tags-lookup (class-list signature ftr-regexp &optional other-win) - "Display routine definition derived from CLASS-LIST, matching SIGNATURE (string) and FTR-REGEXP (regexp matching SIGNATURE). -Use routine tags table to locate a match. Caller must use 'set-buffer' -to restore prior buffer when a match is not found." - (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file)) - (let ((classes class-list) - (found-ftr) - (class)) - (if (null class-list) - nil - (while (and (not found-ftr) classes) - (setq class (car classes) - found-ftr (br-feature-found-p - (br-feature-file signature) - ftr-regexp nil other-win t) - classes (if found-ftr nil (cdr classes)))) - (if found-ftr - (or class t) - (objc-feature-tags-lookup - (apply 'append (mapcar (function (lambda (cl) (br-get-parents cl))) - class-list)) - signature - ftr-regexp - other-win))))) - (defun objc-files-with-source (class) "Use CLASS to compute set of files that match to an Objective-C source file regexp. Return as a list." @@ -663,7 +685,7 @@ (if (and br-feature-tags-file (file-exists-p br-feature-tags-file) (file-readable-p br-feature-tags-file)) - (objc-feature-tags-lookup + (objc-feature-display class-list signature ftr-regexp other-win) ;; Only works if features are in same directory as class def. (objc-scan-ancestors-feature class-list ftr-regexp other-win))