diff lisp/oobr/br.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.el	Mon Aug 13 08:50:31 2007 +0200
+++ b/lisp/oobr/br.el	Mon Aug 13 08:51:03 2007 +0200
@@ -6,12 +6,12 @@
 ;; KEYWORDS:     matching, oop, tools
 ;;
 ;; AUTHOR:       Bob Weiner
-;; ORG:          Motorola Inc.
+;; ORG:          InfoDock Associates
 ;;
 ;; ORIG-DATE:    12-Dec-89
-;; LAST-MOD:     21-Sep-95 at 12:39:17 by Bob Weiner
+;; LAST-MOD:     21-Feb-97 at 16:45:11 by Bob Weiner
 ;;
-;; Copyright (C) 1989-1995  Free Software Foundation, Inc.
+;; Copyright (C) 1989-1996  Free Software Foundation, Inc.
 ;; See the file BR-COPY for license information.
 ;;
 ;; This file is part of the OO-Browser.
@@ -61,8 +61,8 @@
   "*Minimum width of a browser class list window.
 This together with the frame width determines the number of such windows.")
 
-;; -f treats upper and lower case the same in sorting, also makes 'a' sort
-;; list before '[a]', so default classes appear at the end of the list,
+;; -f treats upper and lower case the same in sorting, also makes `a' sort
+;; list before `[a]', so default classes appear at the end of the list,
 ;; typically.
 ;; -u leaves only unique elements in the sorted list
 (defvar br-sort-options "-fu"
@@ -114,10 +114,10 @@
       (if br-inhibit-version
 	  (br-top-classes t)
 	(br-version)
-	(message "Press {h} for for help.")
+	(message "Press {h} for help; use {C-c #} to see version and credits again.")
 	;; Display all classes.
 	(br-top-classes t)
-	(message "Press {h} for for help.")
+	(message "Press {h} for help; use {C-c #} to see version and credits again.")
 	;; Wait for 60 seconds or until a single key sequence is given.
 	(sit-for 60)
 	(message ""))
@@ -132,7 +132,7 @@
 current buffer file pathname.  If optional LIB-TABLE-P is non-nil, add to
 Library Environment, otherwise add to System Environment.  If optional
 SAVE-FILE is t, the Environment is then stored to the filename given by
-'br-env-file'.  If SAVE-FILE is non-nil and not t, its string value is used
+`br-env-file'.  If SAVE-FILE is non-nil and not t, its string value is used
 as the file to which to save the Environment."
   (interactive
     (list (read-file-name (concat "Class file name to add"
@@ -191,10 +191,10 @@
 (defun br-ancestors (&optional arg features-flag)
   "Display ancestor tree whose root is the current class.
 With optional prefix ARG, display all ancestor trees whose roots are in the
-current listing.  If ARG = -1 or 'br-invert-ancestors' is t, the current
+current listing.  If ARG = -1 or `br-invert-ancestors' is t, the current
 class ancestry tree is inverted.  That is, it shows branches going down
 towards the root class, so that parents appear above children.  If ARG < -1 or
-'br-invert-ancestors' is t and ARG > 1, then the ancestry trees of all
+`br-invert-ancestors' is t and ARG > 1, then the ancestry trees of all
 classes in the current listing are inverted.
 
 Optional second argument, FEATURES-FLAG non-nil means display features under
@@ -288,7 +288,7 @@
 			(cons class class-and-categories)))
 		     class-list)))
     (cond ((not class-list)
-	   (message "(OO-Browser):  Apply 'br-categories' to a class.") (beep))
+	   (message "(OO-Browser):  Apply `br-categories' to a class.") (beep))
 	  ((not has-categories)
 	   (message "No class categories.") (beep))
 	  (t
@@ -332,7 +332,7 @@
 				      (cons parent children)))
 				   class-list)))
     (cond ((not children-list)
-	   (message "(OO-Browser):  Apply 'br-children' to a class.")
+	   (message "(OO-Browser):  Apply `br-children' to a class.")
 	   (beep))
 	  ((not has-children)
 	   (message "No children.") (beep))
@@ -469,7 +469,8 @@
 (defun br-edit (&optional prompt class)
   "Edit a class in the viewer window.
 Select viewer window.  With optional prefix arg PROMPT, prompt for class
-name.  Optional CLASS is the one to edit."
+name.  Optional CLASS is the one to edit.  Return t if class is displayed or
+sent to an external viewer, else nil."
   (interactive "P")
   (or br-editor-cmd
       (br-in-view-window-p)
@@ -478,7 +479,7 @@
 
 (defun br-edit-ext (editor-cmd file)
   "Invoke a non-standard EDITOR-CMD on FILE.
-See also 'br-editor-cmd'."
+See also `br-editor-cmd'."
   (interactive "fFile to edit: ")
   (or editor-cmd (setq editor-cmd br-editor-cmd))
   (if (not (stringp editor-cmd)) ;; must be a Lisp function that takes a
@@ -509,12 +510,12 @@
       (let ((class-name (br-find-class-name)))
 	(if class-name
 	    (progn
-	      (message "Building '%s' class info..." class-name)
-	      ; (sit-for 2)   ; Why should we pause here?
+	      (message "Building `%s' class info..." class-name)
+	      (sit-for 2)
 	      (br-store-class-info class-name)
-	      (message "Building '%s' class info...Done" class-name)
+	      (message "Building `%s' class info...Done" class-name)
 	      (br-funcall-in-view-window
-	       (concat br-buffer-prefix-info "Info")
+	       (concat br-buffer-prefix-info "Info*")
 	       'br-insert-class-info))
 	  (error "Move point to a class name line.")))
     (beep)
@@ -568,10 +569,10 @@
 (defun br-features (arg)
   "Display features/elements of the current class (prefix ARG = 1) or of the current listing if ARG is other than 0 or 1.
 
-With ARG = 0, the value of the variable, 'br-inherited-features-flag', is
+With ARG = 0, the value of the variable, `br-inherited-features-flag', is
 toggled and no other action is taken.
 
-If 'br-inherited-features-flag' is t, all features of each class are shown.
+If `br-inherited-features-flag' is t, all features of each class are shown.
 If nil, only lexically included features are shown and if the features of a
 single class are requested and none are defined, the class definition is
 displayed so that its feature declarations may be browsed."
@@ -596,7 +597,7 @@
 		 (br-find-feature element)
 	       (br-find-class element))))
       element
-    (error "(OO-Browser): '%s' definition not found." element)))
+    (error "(OO-Browser): `%s' definition not found." element)))
 
 (defun br-help (&optional file)
   "Display browser operation help information in viewer window."
@@ -633,7 +634,7 @@
 			 (list (br-find-feature-entry)))))))
     (if (or (null ftr-list) (null (car ftr-list)))
 	(error
-	  "(OO-Browser):  'br-implementors' must be applied to a feature.")
+	  "(OO-Browser):  `br-implementors' must be applied to a feature.")
       (message "Computing implementors...")
       (br-add-level-hist)
       (br-next-listing-window -1)
@@ -706,7 +707,7 @@
 		     class-list)))
     (cond ((not class-list)
 	   (beep)
-	   (message "(OO-Browser):  Apply 'br-features' to a class."))
+	   (message "(OO-Browser):  Apply `br-features' to a class."))
 	  ((not has-features)
 	   (if (and (= (length class-list) 1)
 		    (br-class-path (car class-list)))
@@ -768,7 +769,7 @@
 			       (if arg
 				   "Find Environment class string matches"
 				 "Find Environment class regular expression matches")
-			       (if again " (RTN to end): " ": ")))))
+			       (if again " (RET to end): " ": ")))))
   (if (and again (equal expr ""))
       nil
     (let* ((match-expr (if arg (regexp-quote expr) expr))
@@ -804,7 +805,7 @@
 				(if arg
 				    "Find string matches in listing"
 				  "Find regular expression matches in listing")
-				(if again " (RTN to end): " ": ")))))
+				(if again " (RET to end): " ": ")))))
   (if (and again (equal expr ""))
       nil
     (let* ((match-expr (if arg (regexp-quote expr) expr))
@@ -893,7 +894,7 @@
 			       (cons class parents)))
 			    class-list)))
     (cond ((not parents-list)
-	   (message "(OO-Browser):  Apply 'br-parents' to a class.") (beep))
+	   (message "(OO-Browser):  Apply `br-parents' to a class.") (beep))
 	  ((not has-parents)
 	   (message "No parents.") (beep))
 	  (t
@@ -955,7 +956,7 @@
 		       class-list)))
       (cond ((not class-list)
 	     (beep)
-	     (message "(OO-Browser):  Apply 'br-protocols' to a class."))
+	     (message "(OO-Browser):  Apply `br-protocols' to a class."))
 	    ((not has-protocols)
 	     (message "No class protocols.") (beep))
 	    (t
@@ -1005,7 +1006,7 @@
   "Send a message to the OO-Browser discussion list."
   (interactive)
   (if (br-in-browser) (br-to-view-window))
-  (hmail:compose "oo-browser@hub.ucsb.edu" '(hypb:configuration)))
+  (hmail:compose "oo-browser@infodock.com" '(hypb:configuration)))
 
 (defun br-sys-rebuild ()
   "Rescan System components of the current Environment."
@@ -1042,14 +1043,14 @@
     (br-to-view-window)))
 
 (defun br-toggle-c-tags ()
-  "Toggle the value of the 'br-c-tags-flag' flag."
+  "Toggle the value of the `br-c-tags-flag' flag."
   (interactive)
   (setq br-c-tags-flag (not br-c-tags-flag))
   (message "C constructs will %sbe added to C-based language Environments."
 	   (if br-c-tags-flag "" "not ")))
 
 (defun br-toggle-keep-viewed ()
-  "Toggle the value of the 'br-keep-viewed-classes' flag."
+  "Toggle the value of the `br-keep-viewed-classes' flag."
   (interactive)
   (setq br-keep-viewed-classes (not br-keep-viewed-classes))
   (message "Viewed classes will no%s be kept after use."
@@ -1094,15 +1095,15 @@
 (defun br-version ()
   "Display browser version number and credits."
   (interactive)
-  (br-file-to-viewer "BR-VERSION")
   (br-funcall-in-view-window
-   (concat br-buffer-prefix-info "Help")
+   (concat br-buffer-prefix-info "Help*")
    (function (lambda ()
+	       (insert-file-contents (br-pathname "BR-VERSION"))
+	       (hypb:display-file-with-logo)
 	       (if (re-search-forward "<VERSION>" nil t)
 		   (replace-match br-version t t))
 	       (center-line)
-	       (set-buffer-modified-p nil)))
-   t))
+	       (set-buffer-modified-p nil)))))
 
 (defun br-view-entry (&optional prompt)
   "Displays source for any browser listing entry.
@@ -1129,9 +1130,7 @@
   "Displays class file in viewer window.
 Optional prefix arg PROMPT means prompt for class name.  Non-nil WRITABLE means
 allow editing, otherwise display in read-only mode.  Non-nil CLASS is class to
-display.
-
-Return t if class is displayed or sent to an external viewer, else nil."
+display.  Return t if class is displayed or sent to an external viewer, else nil."
   (interactive "P")
   (or class (setq class (if prompt (br-complete-class-name)
 			  (br-find-class-name))))
@@ -1172,7 +1171,7 @@
 
 (defun br-view-ext (viewer-cmd file)
   "Invoke a non-standard VIEWER-CMD on FILE.
-See also 'br-viewer-cmd'."
+See also `br-viewer-cmd'."
   (interactive "fFile to view: ")
   (or viewer-cmd (setq viewer-cmd br-viewer-cmd))
   (if (not (stringp viewer-cmd)) ;; must be a Lisp function that takes a
@@ -1356,7 +1355,7 @@
   (equal 0 (string-match (concat br-buffer-prefix-inher
 				 "\\|" br-buffer-prefix-categ
 				 "\\|" br-buffer-prefix-blank
-				 "\\|" br-buffer-prefix-info)
+				 "\\|" (regexp-quote br-buffer-prefix-info))
 			 (buffer-name buffer))))
 
 (defun br-buffer-level ()
@@ -1502,7 +1501,7 @@
   "Display FILENAME from OO-Browser source directory in browser viewer window.
 FILENAME should not contain any path information."
   (br-funcall-in-view-window
-   (concat br-buffer-prefix-info "Help")
+   (concat br-buffer-prefix-info "Help*")
    (function (lambda ()
 	       (insert-file-contents (br-pathname filename))
 	       (set-buffer-modified-p nil)))))
@@ -1510,7 +1509,9 @@
 (defun br-in-browser ()
   "Return selected frame if the OO-Browser is active in it, else return nil."
   (cond ((not (eq br-in-browser (selected-frame))) nil)
-	((one-window-p 'nomini)
+	((or (one-window-p 'nomini)
+	     (and (fboundp 'window-list)
+		  (< (length (window-list)) 3)))
 	 (setq br-in-browser nil))
 	(t br-in-browser)))
 
@@ -1580,14 +1581,14 @@
 	((br-find-class-name)
 	 (narrow-to-region (match-beginning 0) (match-end 0)))
 	(t (error
-	    "(OO-Browser):  'br-narrow-to-class', current entry is not a class"))))
+	    "(OO-Browser):  `br-narrow-to-class', current entry is not a class"))))
 
 (defun br-narrow-to-feature ()
   "Narrow buffer to current feature entry."
   (if (br-feature-at-p)
       (narrow-to-region (match-beginning 0) (match-end 0))
     (error
-     "(OO-Browser):  'br-narrow-to-feature' no current feature.")))
+     "(OO-Browser):  `br-narrow-to-feature' no current feature.")))
 
 (defun br-feature-at-p ()
   "Returns t iff point is on a feature listing line."
@@ -1631,7 +1632,7 @@
   "Return full pathname for FILENAME in browser Elisp directory."
   (if br-directory
       (expand-file-name filename br-directory)
-    (error "The 'br-directory' variable must be set to a string value.")))
+    (error "The `br-directory' variable must be set to a string value.")))
 
 (defun br-protocol-entry-p ()
   "Return non-nil if point is within a protocol listing entry line."
@@ -1888,13 +1889,13 @@
   "List of directories below which OO source files and other library
 directories are found.  A library is a stable group of OO classes.  Do not
 set this variable directly.  Each OO language library which invokes
-'br-browse' should set it.")
+`br-browse' should set it.")
 
 (defvar br-sys-search-dirs nil
   "List of directories below which OO source files and other system
 directories are found.  A system is a group of OO classes that are likely to
 change.  Do not set this variable directly.  Each OO language library which
-invokes 'br-browse' should set it.")
+invokes `br-browse' should set it.")
 
 (defvar *br-level-hist* nil
   "Internal history of visited listing windows and buffers.")
@@ -1912,7 +1913,7 @@
 (defconst br-buffer-prefix-categ "Categ-Lvl-")
 (defconst br-buffer-prefix-inher "Inher-Lvl-")
 (defconst br-buffer-prefix-blank "Blank-")
-(defconst br-buffer-prefix-info "OO-Browser ")
+(defconst br-buffer-prefix-info "*OO-Browser ")
 (defvar br-buffer-prefix br-buffer-prefix-inher
   "Browser buffer name prefix.")
 
@@ -1935,21 +1936,21 @@
   (define-key br-mode-map "\C-c\C-c" 'br-env-create)
   (define-key br-mode-map "d"        'br-descendants)
   (define-key br-mode-map "\C-c\C-d" 'br-delete)
-  ;; {M-d} is used down below for 'br-tree'
+  ;; {M-d} is used down below for `br-tree'
   (define-key br-mode-map "e"        'br-edit-entry)
   (define-key br-mode-map "\M-e"     'br-env-stats)
   (define-key br-mode-map "\C-c\C-e" 'br-env-rebuild)
   (define-key br-mode-map "f"        'br-features)
   (define-key br-mode-map "F"        'br-feature-signature)
-  ;; {M-f} is used down below for 'br-tree-features-toggle'
-  ;; {M-g} is used down below for 'br-tree-graph'
+  ;; {M-f} is used down below for `br-tree-features-toggle'
+  ;; {M-g} is used down below for `br-tree-graph'
   (define-key br-mode-map "?"        'br-help)
   (define-key br-mode-map "h"        'br-help)
   (define-key br-mode-map "H"        'br-help-ms) ;; mouse help
   (define-key br-mode-map "i"        'br-entry-info)
   (define-key br-mode-map "I"        'br-implementors)
   (define-key br-mode-map "\C-c\C-k" 'br-kill)
-  ;; {M-k} is used down below for 'br-tree-kill'
+  ;; {M-k} is used down below for `br-tree-kill'
   (define-key br-mode-map "l"        'br-lib-top-classes)
   (define-key br-mode-map "L"        'br-lib-rebuild)
   (define-key br-mode-map "\C-c\C-l" 'br-env-load)
@@ -1996,6 +1997,6 @@
 (defvar br-tmp-class-set nil
   "Set of classes created for temporary use by br-*-trees functions.")
 (defvar br-tmp-depth 0
-  "Temporary variable indicating inheritance depth of class in 'br-ancestor-trees'.")
+  "Temporary variable indicating inheritance depth of class in `br-ancestor-trees'.")
 
 (provide 'br)