diff lisp/oobr/br-ftr.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-ftr.el	Mon Aug 13 08:50:31 2007 +0200
+++ b/lisp/oobr/br-ftr.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:    20-Aug-91 at 18:16:36
-;; LAST-MOD:     25-Aug-95 at 16:54:53 by Bob Weiner
+;; LAST-MOD:     20-Feb-97 at 07:02:51 by Bob Weiner
 ;;
-;; Copyright (C) 1991-1995, Free Software Foundation, Inc.
+;; Copyright (C) 1991-1996, Free Software Foundation, Inc.
 ;; See the file BR-COPY for license information.
 ;;
 ;; This file is part of the OO-Browser.
@@ -24,29 +24,30 @@
 ;;; ************************************************************************
 
 (defconst br-feature-type-regexp "[-+=@%>1/]"
-  "Regular expression which matches the first non-whitespace characters in an OO-Browser feature listing.")
+  "Regular expression which matches the first non-whitespace character in an OO-Browser feature listing.")
 
 ;;; ************************************************************************
 ;;; Public functions
 ;;; ************************************************************************
 
-(defun br-find-feature (&optional feature-entry view-only other-win)
-  "Display feature definition for FEATURE-ENTRY in VIEW-ONLY mode if non-nil.
-Return feature path if FEATURE-ENTRY is successfully displayed, nil
-otherwise.  Can also signal an error when called interactively."
-  (interactive)
-  (and (interactive-p) (setq view-only current-prefix-arg))
-  (let ((feature-path))
-    (setq feature-entry
-	  (br-feature-signature-and-file
-	   (or feature-entry
-	       (br-feature-complete 'must-match "Show feature definition:")))
-	  feature-path (cdr feature-entry)
-	  feature-entry (car feature-entry))
-    (br-edit-feature feature-entry feature-path other-win view-only)))
+(defun br-edit-feature (class feature-name &optional other-win view-only)
+  "Edit the definition of CLASS' FEATURE-NAME, optionally in some OTHER-WIN if non-nil.
+With optional VIEW-ONLY non-nil, view the feature definition instead of editing it.
+Return the pathname of the feature definition if found, else nil."
+  (interactive
+   (list nil (br-feature-complete 'must-match "Edit feature definition:")
+	 nil nil))
+  (let ((tag-and-file (br-feature-tag-and-file
+		       (if (null class)
+			   ;; Assume feature-name includes prepended class in
+			   ;; proper format, e.g. when called interactively.
+			   (regexp-quote feature-name)
+			 (br-feature-tag-regexp class feature-name)))))
+    (if tag-and-file (br-edit-feature-from-tag
+		      (car tag-and-file) (cdr tag-and-file) other-win view-only))))
 
-(defun br-edit-feature (tag-entry feature-path &optional other-win view-only)
-  "Edit feature for OO-Browser TAG-ENTRY of file FEATURE-PATH, optionally in OTHER-WIN.
+(defun br-edit-feature-from-tag (tag-entry feature-path &optional other-win view-only)
+  "Edit feature for OO-Browser TAG-ENTRY of file FEATURE-PATH, optionally in OTHER-WIN if non-nil.
 With optional VIEW-ONLY, view feature definition instead of editing it.
 Return FEATURE-PATH if feature definition is found, else nil."
   (let ((err))
@@ -65,18 +66,36 @@
 		 ((interactive-p)
 		  (setq err
 			(format
-			 "(OO-Browser):  No '%s' feature defined in Environment."
+			 "(OO-Browser):  No `%s' feature defined in Environment."
 			 tag-entry)
 			feature-path nil))))
 	  ((interactive-p)
 	   (setq err
 		 (format
-		  "(OO-Browser):  '%s' - src file not found or not readable, %s"
+		  "(OO-Browser):  `%s' - src file not found or not readable, %s"
 		  tag-entry feature-path)
 		 feature-path nil)))
     (if err (error err))
     feature-path))
 
+(defun br-find-feature (&optional feature-entry view-only other-win)
+  "Display feature definition for FEATURE-ENTRY in VIEW-ONLY mode if non-nil.
+Return feature path if FEATURE-ENTRY is successfully displayed, nil
+otherwise.  Can also signal an error when called interactively."
+  (interactive)
+  (and (interactive-p) (setq view-only current-prefix-arg))
+  (let ((feature-path))
+    (setq feature-entry
+	  (br-feature-signature-and-file
+	   (or feature-entry
+	       (br-feature-complete 'must-match
+				    (if view-only
+					"View feature definition:"
+				      "Edit feature definition:"))))
+	  feature-path (cdr feature-entry)
+	  feature-entry (car feature-entry))
+    (br-edit-feature-from-tag feature-entry feature-path other-win view-only)))
+
 (defun br-find-feature-entry ()
   "Return feature entry that point is within or nil."
   (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
@@ -143,7 +162,7 @@
 			   (not (looking-at "\^L\\|\\'")))
 		 (setq ftr-alist (cons (cons (br-feature-signature-to-name
 					      (br-feature-current)
-					      t)
+					      t t)
 					     nil)
 				       ftr-alist)))))
 	   (kill-buffer ftr-buf)
@@ -194,7 +213,7 @@
 	(goto-char (point-min))
 	(setq found-def 
 	      (cond (deferred-class
-		      (br-feature-locate-p feature-tag deferred-class))
+		     (br-feature-locate-p feature-tag deferred-class))
 		    (regexp-flag
 		     (br-feature-locate-p feature-tag regexp-flag))
 		    (t (br-feature-locate-p feature-tag))))
@@ -341,7 +360,7 @@
 ;;; ************************************************************************
 
 (defun br-feature-tags-init ()
-  "Set up 'br-feature-tags-file' for writing."
+  "Set up `br-feature-tags-file' for writing."
   (setq br-feature-tags-completions nil
 	br-feature-tags-file (br-feature-tags-file-name br-env-file)
 	br-tags-file (concat br-env-file "-TAGS"))
@@ -352,7 +371,7 @@
   (concat env-file "-FTR"))
 
 (defun br-feature-tags-save ()
-  "Filter out extraneous lines and save 'br-feature-tags-file'."
+  "Filter out extraneous lines and save `br-feature-tags-file'."
   (let ((obuf (current-buffer)))
     (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
     (goto-char (point-min))
@@ -402,6 +421,19 @@
       (end-of-line)
       (buffer-substring start (point)))))
 
+(defun br-feature-tag-and-file (feature-tag-regexp)
+  "Return a cons (FEATURE-TAG . FEATURE-DEF-FILENAME) for the first tag match of FEATURE-TAG-REGEXP, or nil.
+Use br-feature-tag-regexp to create FEATURE-TAG-REGEXP.
+Feature tags come from the file named by br-feature-tags-file."
+  (let ((obuf (current-buffer))
+	result)
+    (unwind-protect
+	(progn
+	  (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
+	  (setq result (br-feature-def-file feature-tag-regexp))
+	  (if result (cons (br-feature-current) result)))
+      (set-buffer obuf))))
+
 ;;; ************************************************************************
 ;;; Private variables
 ;;; ************************************************************************