diff lisp/oobr/br-eif-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-eif-ft.el	Mon Aug 13 08:50:31 2007 +0200
+++ b/lisp/oobr/br-eif-ft.el	Mon Aug 13 08:51:03 2007 +0200
@@ -6,12 +6,12 @@
 ;; KEYWORDS:     oop, tools
 ;;
 ;; AUTHOR:       Bob Weiner
-;; ORG:          Motorola Inc.
+;; ORG:          InfoDock Associates
 ;;
 ;; ORIG-DATE:    03-Oct-90
-;; LAST-MOD:     11-May-95 at 11:24:33 by Bob Weiner
+;; LAST-MOD:     31-Oct-96 at 17:05:31 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.
@@ -19,27 +19,52 @@
 ;; DESCRIPTION:  
 ;; DESCRIP-END.
 
-;; ************************************************************************
-;; Other required Elisp libraries
-;; ************************************************************************
+;;; ************************************************************************
+;;; Other required Elisp libraries
+;;; ************************************************************************
 
 (require 'eif-calls)
 
-;; ************************************************************************
-;; Public variables
-;; ************************************************************************
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
 
 (defconst eif-type-tag-separator ","
   "String that separates a tags type from its normalized definition form.")
 
-;; ************************************************************************
-;; Public functions
-;; ************************************************************************
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
 
 (defun eif-feature-implementors (ftr-name)
   "Return unsorted list of Eiffel feature tags which implement FTR-NAME."
   (eif-feature-matches (concat "^" (regexp-quote ftr-name) "$")))
 
+(defun eif-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 eif-type-tag-separator))
+	(results)
+	start end)
+    (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+    (goto-char 1)
+    (if (not (search-forward class-tag nil t))
+	nil
+      (setq start (match-beginning 0)
+	    end (if (search-forward "\^L\n" nil t)
+		    (match-beginning 0)
+		  (point-max)))
+      (goto-char start)
+      ;; Feature defs can occur only within a single file.
+      (while (search-forward class-tag end 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 eif-feature-name-to-regexp (name)
   "Converts feature NAME into a regular expression matching the feature's name tag."
   (if (string-match (concat "^" br-feature-type-regexp " ") name)
@@ -52,7 +77,7 @@
 
 (defun eif-feature-signature-to-regexp (signature)
   "Given an Eiffel class or feature SIGNATURE, return regexp to match its definition."
-  (let ((regexp) class name type)
+  (let ((regexp) name type)
     (setq regexp
 	  (cond ((string-match (concat eif-type-tag-separator
 				       "\\(" br-feature-type-regexp "\\) ")
@@ -75,31 +100,18 @@
 	(error "(eif-feature-signature-to-regexp): Invalid format, '%s'"
 	       signature))))
 
+(defun eif-feature-tag-regexp (class feature-name)
+  "Return a regexp that matches to the feature tag entry for CLASS' FEATURE-NAME."
+  (concat "^" (regexp-quote class) eif-type-tag-separator
+	  br-feature-type-regexp " "
+	  (regexp-quote feature-name) "[ \n]"))
+
 (defun eif-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))
   (br-feature-found-p (br-feature-file class-or-signature)
 		      class-or-signature))
 
-(defun eif-list-features (class &optional indent)
-  "Return sorted list of Eiffel feature names lexically defined in CLASS."
-  (let ((class-tag (concat "\n" class eif-type-tag-separator))
-	(features) start end)
-    (save-excursion
-      (set-buffer
-       (funcall br-find-file-noselect-function br-feature-tags-file))
-      (goto-char 1)
-      (if (not (search-forward class-tag nil t))
-	  nil
-	(setq start (match-beginning 0)
-	      end (if (search-forward "\^L\n" nil t)
-		      (match-beginning 0)
-		    (point-max)))
-	(goto-char start)
-	;; Feature defs can occur only within a single file.
-	(while (search-forward class-tag end t)
-	  (setq features (cons (br-feature-current) features)))
-	(eif-sort-features features)))))
 
 (defun eif-get-feature-tags (feature-file feature-list)
   "Save Eiffel feature tags defined in FEATURE-FILE to 'br-feature-tags-file'.
@@ -124,6 +136,14 @@
 		       feature-list)))
     (set-buffer obuf)))
 
+(defun eif-list-features (class &optional indent)
+  "Return sorted list of Eiffel feature names lexically defined in CLASS.
+Optional INDENT is unused but is required for multi-language OO-Browser conformance."
+  ;; Use nreverse here so that stable sort ends up leaving same named
+  ;; features in the order they were defined in the source file.
+  (eif-sort-features
+   (eif-feature-map-class-tags 'br-feature-current class)))
+
 (defun eif-scan-features-in-class (class start end)
   "Return unordered list of Eiffel feature definitions in CLASS.
 START and END give buffer region to search."
@@ -161,9 +181,9 @@
 	nil))
      )))
 
-;; ************************************************************************
-;; Private functions
-;; ************************************************************************
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
 
 (defun eif-export-feature-p ()
   "Return nil unless point is within a class export clause."
@@ -225,41 +245,44 @@
       (goto-char opoint)
       nil)))
 
-(defun eif-feature-matches (regexp)
-  "Return an unsorted list of feature tags whose names match in part or whole to REGEXP."
-  ;; Ensure match to feature names only; also handle "^" and "$" meta-chars
-  (setq regexp
-	(concat "^\\(" eif-identifier "\\)"
-		eif-type-tag-separator
-		br-feature-type-regexp " "
-		(if (equal (substring regexp 0 1) "^")
-		    (progn (setq regexp (substring regexp 1)) nil)
-		  (concat "[" eif-identifier-chars "]*"))
-		(if (equal (substring regexp -1) "$")
-		    (substring regexp 0 -1)
-		  (concat regexp "[" eif-identifier-chars "]*"))
-		"[ \t\n\r]"))
-  (save-excursion
-    (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
-    (goto-char 1)
-    (let ((features) start end)
-      (if (not (re-search-forward regexp nil t))
-	  nil
-	(setq start (match-beginning 0)
-	      end (if (search-forward "\^L\n" nil t)
-		      (match-beginning 0)
-		    (point-max)))
-	(goto-char start)
-	;; Feature defs can occur only within a single file.
-	(while (re-search-forward regexp end t)
-	  (backward-char) ;; Might have moved past newline.
-	  (setq features (cons (br-feature-current) features))))
-      features)))
-
 (defun eif-feature-lessp (feature1 feature2)
   (string-lessp (eif-feature-partial-name feature1)
 		(eif-feature-partial-name feature2)))
 
+(defun eif-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 "[" eif-identifier-chars "]*"))
+	(results))
+    ;; Ensure match to feature names only; also handle "^" and "$" meta-chars
+    (setq regexp
+	  (concat "^\\(" eif-identifier "\\)"
+		  eif-type-tag-separator
+		  br-feature-type-regexp " "
+		  (if (equal (substring regexp 0 1) "^")
+		      (progn (setq regexp (substring regexp 1)) nil)
+		    identifier-chars)
+		  (if (equal (substring regexp -1) "$")
+		      (substring regexp 0 -1)
+		    (concat regexp identifier-chars))
+		  "[ \t\n\r\f]"))
+    (save-excursion
+      (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+      (goto-char 1)
+      (while (re-search-forward regexp nil t)
+	(setq results (cons (funcall function) results))))
+    results))
+
+(defun eif-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."
+  (eif-feature-map-tags
+   ;; Backward-char is necessary in this next function since point might have
+   ;; moved past a newline.
+   (function (lambda () (backward-char) (br-feature-current)))
+   regexp))
+
 (defun eif-feature-partial-name (signature &optional with-class for-display)
   "Extract the feature name without its class name from feature SIGNATURE.
 If optional WITH-CLASS is non-nil, class name and 'eif-type-tag-separator'
@@ -319,21 +342,6 @@
 ;; feature in buffers whose major mode is 'eiffel-mode'.  It is used by the
 ;; browser but may also be used standalone.
 ;;
-(defun eiffel-find-feature (feature-name)
-  "Move point to start of feature named FEATURE-NAME in current buffer.
-Display feature including all preceding comments at the top of the window.
-Move point and return non-nil iff FEATURE-NAME is found."
-  (interactive "sFeature to find: ")
-  (cond ((eif-locate-feature
-	  feature-name (eif-routine-to-regexp feature-name)))
-	((eif-to-attribute feature-name)
-	 (let ((opoint (point)))
-	   (eif-to-comments-begin)
-	   (recenter 0)
-	   (goto-char opoint)
-	   (back-to-indentation)
-	   t))))
-
 (defun eif-find-class-name ()
   "Return class name that point is within, else nil."
   (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
@@ -474,9 +482,24 @@
       (buffer-substring (match-beginning 0) (match-end 0))))
 
 
-;; ************************************************************************
-;; Private variables
-;; ************************************************************************
+(defun eiffel-find-feature (feature-name)
+  "Move point to start of feature named FEATURE-NAME in current buffer.
+Display feature including all preceding comments at the top of the window.
+Move point and return non-nil iff FEATURE-NAME is found."
+  (interactive "sFeature to find: ")
+  (cond ((eif-locate-feature
+	  feature-name (eif-routine-to-regexp feature-name)))
+	((eif-to-attribute feature-name)
+	 (let ((opoint (point)))
+	   (eif-to-comments-begin)
+	   (recenter 0)
+	   (goto-char opoint)
+	   (back-to-indentation)
+	   t))))
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
 
 (defconst eif-feature-name
   (concat