xemacs-beta: lisp/oobr/br.el comparison

comparison lisp/oobr/br.el @ 100:4be1180a9e89 r20-1b2

Import from CVS: tag r20-1b2

author	cvs
date	Mon, 13 Aug 2007 09:15:11 +0200
parents	131b0175ea99
children	cca96a509cfe

comparison

equal deleted inserted replaced

-:2d83cbd90d8d
+:4be1180a9e89
 ;; SUMMARY:      Browse object-oriented code.
 ;; USAGE:        GNU Emacs Lisp Library
 ;; 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.
 ;;
 ;; DESCRIPTION:
 (defconst br-min-width-window 25
 "*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
+;; -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,
+;; 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"
 "*String of options to send to the operating system `sort' command.
 Use nil for none.  This is used by the OO-Browser (br-order) command only
 	(set-window-configuration *br-save-wconfig*)
 (br-window-setup)
 (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 ""))
 (br-help))
 (run-hooks 'br-mode-hook
 "Add a file of classes to the current Environment.
 Interactively or when optional CLASS-PATH is nil, CLASS-PATH defaults to the
 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"
 				  (if buffer-file-name
 				      (concat " (default \""
 	((br-env-save save-file))))
 (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
 each ancestor class."
 (interactive "p")
 			      has-categories (or has-categories
 						 class-and-categories))
 			(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
 	   (br-add-level-hist)
 	   (br-next-buffer nil)
 					    has-children
 					    (or has-children children))
 				      (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))
 	  (t
 	   (br-add-level-hist)
 	    (t (error "(OO-Browser): No entry for current line in current Environment"))))))
 (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)
 (setq *br-prev-listing-window* (selected-window)))
 (br-view prompt t class))
 (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
 ;; single, file arg
 (funcall editor-cmd file)
 (interactive)
 (if (fboundp 'br-insert-class-info)
 (let ((class-name (br-find-class-name)))
 	(if class-name
 	    (progn
-	      (message "Building '%s' class info..." class-name)
+	      (message "Building `%s' class info..." class-name)
-	      ; (sit-for 2)   ; Why should we pause here?
+	      (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)
 (message "No class information function for this language.")))
 (error "(br-feature): Can't find definition of: '%s'" ftr-sig))))
 (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."
 (interactive "p")
 (cond ((and (integerp arg) (= arg 0))
 	     (if (not (br-in-view-window-p)) (br-to-from-viewer))
 	     (if (string-match br-feature-signature-regexp element)
 		 (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."
 (interactive)
 (or file (setq file "br-help"))
 		     (skip-chars-forward " \t")
 		     (if (looking-at br-feature-entry)
 			 (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)
 (br-next-buffer (concat "p" child-level))
 (let ((buffer-read-only) (implementor-tags) (classes)
 					       class-and-features))
 			(cons class class-and-features)))
 		     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)))
 	       (if (br-view nil nil (car class-list))
 		   (message
 (or expr (setq expr (read-string
 		       (concat (if again (format "(%s matches)  " matched))
 			       (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))
 	   (classes
 	    (delq nil (mapcar
 (or expr (setq expr (read-string
 			(concat (if again (format "(%s matches)  " matched))
 				(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))
 	   (buffer-read-only))
 (goto-char (point-min))
 			       (setq parents (br-get-parents class)
 				     has-parents (or has-parents parents))
 			       (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
 	   (let ((child-level (br-buffer-level)))
 	     (br-add-level-hist)
 						  class-and-protocols))
 			  (cons class class-and-protocols)))
 		       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
 	     (br-add-level-hist)
 	     (br-next-buffer nil)
 (defun br-report-bug ()
 "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."
 (interactive)
 (if (call-interactively 'br-build-sys-htable)
 	       (other-window 1))
 	     (setq *br-prev-listing-window* nil))
 (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."
 	   (if br-keep-viewed-classes "w" "t")))
 (goto-char (point-min))))
 (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)))
+	       (set-buffer-modified-p nil)))))
-t))
 (defun br-view-entry (&optional prompt)
 "Displays source for any browser listing entry.
 Optional prefix arg PROMPT means prompt for entry name."
 (interactive "P")
 (defun br-view (&optional prompt writable class)
 "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.
+display.  Return t if class is displayed or sent to an external viewer, else nil."
-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))))
 (cond ((null class)
 	 (beep)
 				   t)))
 	       (or writable (select-window owind)))))))
 (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
 ;; single, file arg
 (funcall viewer-cmd file)
 (defun br-browser-buffer-p (&optional buffer)
 "Returns t iff optional BUFFER or current buffer is an OO-Browser specific buffer."
 (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 ()
 "Returns current listing buffer level as a string."
 (let* ((name (buffer-name))
 (defun br-file-to-viewer (filename)
 "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)))))
 (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)))
 (defun br-in-top-buffer-p ()
 (defun br-narrow-to-class ()
 (cond ((= (point-min) (point-max)) nil)
 	((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."
 (save-excursion
 (beginning-of-line)
 (defun br-pathname (filename)
 "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."
 (and (string-equal br-lang-prefix "objc-")
 (save-excursion
 (defvar br-lib-search-dirs nil
 "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.")
 (defvar *br-prev-listing-window* nil
 "Saves window configuration between invocations of the browser.")
 (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.")
 (defvar br-mode-map nil
 (define-key br-mode-map "C"        'br-categories)
 (define-key br-mode-map "\M-c"     'br-class-stats)
 (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-f} is used down below for `br-tree-features-toggle'
-;; {M-g} is used down below for 'br-tree-graph'
+;; {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)
 (define-key br-mode-map "m"        'br-match)
 (define-key br-mode-map "M"        'br-match-entries)
 	     (define-key br-mode-map "\M-k" 'br-tree-kill))))
 (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)

Mercurial > hg > xemacs-beta

comparison lisp/oobr/br.el @ 100:4be1180a9e89 r20-1b2