cgit.sxemacs.org Git - packages/blob - xemacs-packages/oo-browser/br.el

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         br.el
   4 ;; SUMMARY:      Browse object-oriented code.
   5 ;; USAGE:        GNU Emacs Lisp Library
   6 ;; KEYWORDS:     matching, oop, tools
   7 ;;
   8 ;; AUTHOR:       Bob Weiner
   9 ;; ORG:          BeOpen.com
  10 ;;
  11 ;; ORIG-DATE:    12-Dec-89
  12 ;; LAST-MOD:     10-May-01 at 20:49:01 by Bob Weiner
  13 ;;
  14 ;; Copyright (C) 1989-1998  BeOpen.com
  15 ;; See the file BR-COPY for license information.
  16 ;;
  17 ;; This file is part of the OO-Browser.
  18 ;;
  19 ;; DESCRIPTION:
  20 ;; DESCRIP-END.
  21
  22 ;;; ************************************************************************
  23 ;;; Other required Elisp libraries
  24 ;;; ************************************************************************
  25
  26 (require 'br-lib)
  27
  28 ;;; ************************************************************************
  29 ;;; Customization
  30 ;;; ************************************************************************
  31
  32 (defgroup oo-browser nil
  33   "Multi-Language Object-Oriented Code Browser"
  34   :group 'tools
  35   :prefix "br-")
  36
  37 (defconst br-feature-signature-regexp "[:|,]"
  38   "Regular expression that matches a feature signature but not a class name.")
  39
  40 (defcustom br-inherited-features-flag t
  41   "*If non-nil (the default), feature/element listings include all inherited features.
  42 If nil, only those features lexically included within a class are shown."
  43   :group 'oo-browser
  44   :type 'boolean)
  45
  46 (defcustom br-protocols-with-classes-flag t
  47   "*If non-nil (the default), protocols (interfaces) are included in listings of all classes or top-level classes."
  48   :group 'oo-browser
  49   :type 'boolean)
  50
  51 (defcustom br-inhibit-version nil
  52   "*If non-nil, skips version/credit information upon startup.
  53 The default should be left as nil, since new users may find this helpful."
  54   :group 'oo-browser
  55   :type 'boolean)
  56
  57 (defcustom br-invert-ancestors nil
  58   "*If non-nil makes ancestors appear as do other inheritance listings.
  59 That is, parents appear above children, rather than the default, which is the
  60 reverse."
  61   :group 'oo-browser
  62   :type 'boolean)
  63
  64 (defcustom br-keep-viewed-classes nil
  65   "*If non-nil means leave all viewed classes around for later selection.
  66 A nil value causes deletion of the last viewed class buffer whenever a new
  67 one is displayed.   Note this does not affect classes displayed for editing,
  68 all such classes are left around."
  69   :group 'oo-browser
  70   :type 'boolean)
  71
  72 (defconst br-min-width-window 25
  73   "*Minimum width of a browser class list window.
  74 This together with the frame width determines the number of such windows.")
  75
  76 ;;; ************************************************************************
  77 ;;; Public macros
  78 ;;; ************************************************************************
  79
  80 (if (fboundp 'window-highest-p)
  81     (defun br-listing-window-p ()
  82       "Is the selected window an OO-Browser listing window?"
  83       (if (br-in-browser) (window-highest-p (selected-window))))
  84   (defun br-listing-window-p ()
  85     "Is the selected window an OO-Browser listing window?"
  86     ;; Top of window is at top of frame.
  87     (if (br-in-browser)
  88         (= (nth 1 (window-edges)) br-top-of-frame))))
  89
  90 (defun br-non-listing-window-p ()
  91   "Is the selected window a non-OO-Browser listing window?"
  92   (not (br-listing-window-p)))
  93
  94 ;;; ************************************************************************
  95 ;;; Public functions
  96 ;;; ************************************************************************
  97
  98 (defun br-browse ()
  99   "Internally invoke the OO-Browser, for browsing class hierarchies.
 100 Use \\[br-help] and \\[br-help-ms] for help on browser usage."
 101   (interactive)
 102   (if (fboundp 'get-frame-for-mode)
 103       (let ((frame (get-frame-for-mode 'br-mode)))
 104         (if (frame-live-p frame)
 105             (if (frame-visible-p frame)
 106                 (select-frame frame)
 107               (make-frame-visible frame)
 108               (select-frame frame)))))
 109   ;; If not already in the browser, save window config.
 110   (if (br-in-browser)
 111       nil
 112     (let* ((env-build-process
 113             (or (and (boundp 'compilation-in-progress)
 114                      (car compilation-in-progress))
 115                 (get-buffer-process "*compilation*")))
 116            (env-being-built
 117             (and env-build-process
 118                  (boundp 'compile-command)
 119                  (stringp compile-command)
 120                  (string-match "oo-browser-env" compile-command)
 121                  (eq (process-status env-build-process) 'run)
 122                  (equal (getenv "OO_BROWSER_ENV") br-env-file))))
 123       (setq *br-prev-wconfig* (current-window-configuration)
 124             br-in-browser (selected-frame))
 125       ;; If were previously in the browser, restore its saved window config,
 126       ;; otherwise, set up from scratch.
 127       (if (and *br-save-wconfig*
 128                (br-set-window-configuration *br-save-wconfig*)
 129                (br-in-browser))
 130           nil
 131         (br-window-setup)
 132         (cond ((not env-being-built)
 133                (br-version)
 134                (message "Press {h} for help; use {C-c #} to see version and credits again.")
 135                (br-show-all-classes)
 136                (message "Press {h} for help; use {C-c #} to see version and credits again.")
 137                ;; Wait for 60 seconds or until a single key sequence is given.
 138                (sit-for 60)
 139                (message ""))
 140               (br-inhibit-version
 141                (br-show-all-classes)))
 142         (if env-being-built nil (br-help)))
 143       (if env-being-built
 144           (let ((owind (selected-window)))
 145             (br-to-view-window)
 146             (switch-to-buffer "*compilation*")
 147             (goto-char (point-max))
 148             (select-window owind)
 149             (message "Waiting for build to finish before loading Environment ...")))
 150       (run-hooks 'br-mode-hook
 151                  (intern (concat "br-" br-lang-prefix "mode-hook"))))))
 152
 153 ;;;  ###autoload
 154 ;(defun br-add-class-file (&optional class-path lib-table-p save-file)
 155 ;  "Add a file of classes to the current Environment.
 156 ;Interactively or when optional CLASS-PATH is nil, CLASS-PATH defaults to the
 157 ;current buffer file pathname.  If optional LIB-TABLE-P is non-nil, add to
 158 ;Library Environment, otherwise add to System Environment.  If optional
 159 ;SAVE-FILE is t, the Environment is then stored to the filename given by
 160 ;`br-env-file'.  If SAVE-FILE is non-nil and not t, its string value is used
 161 ;as the file to which to save the Environment."
 162 ;  (interactive
 163 ;   (let ((class-path
 164 ;         (expand-file-name
 165 ;          (read-file-name (concat "Class file name to add"
 166 ;                                  (if buffer-file-name
 167 ;                                      (concat " (default \""
 168 ;                                              (file-name-nondirectory
 169 ;                                               buffer-file-name)
 170 ;                                              "\")"))
 171 ;                                  ": ")
 172 ;                          nil buffer-file-name t)))
 173 ;        (lib-table-match)
 174 ;        (sys-table-match)
 175 ;        (save-file))
 176 ;     (if (equal class-path "")
 177 ;        nil
 178 ;       (setq lib-table-match
 179 ;            (delq nil
 180 ;                  (mapcar
 181 ;                   (function
 182 ;                    (lambda (search-dir)
 183 ;                      (if (string-match (regexp-quote
 184 ;                                         (expand-file-name search-dir))
 185 ;                                        class-path) t)))
 186 ;                   br-lib-search-dirs)))
 187 ;       (if lib-table-match
 188 ;          nil
 189 ;        (setq sys-table-match
 190 ;              (delq nil
 191 ;                    (mapcar
 192 ;                     (function
 193 ;                      (lambda (search-dir)
 194 ;                        (if (string-match (regexp-quote
 195 ;                                           (expand-file-name search-dir))
 196 ;                                          class-path) t)))
 197 ;                     br-sys-search-dirs)))))
 198 ;     (if (or lib-table-match sys-table-match)
 199 ;        nil
 200 ;       (setq lib-table-match
 201 ;            (y-or-n-p "Add to Library, rather than System part of Environment? ")))
 202 ;     (setq save-file (y-or-n-p
 203 ;                     (format "Save %s after this addition? " br-env-file)))
 204 ;     (list class-path lib-table-match save-file)))
 205
 206 ;  (or class-path (setq class-path buffer-file-name))
 207 ;  (if (not (if class-path (file-readable-p class-path)))
 208 ;      (error "(br-add-class-file): %s is not readable" class-path))
 209 ;  (let* ((paths-parents-cons
 210 ;          (let ((br-view-file-function 'br-insert-file-contents))
 211 ;            (br-get-classes-from-source class-path)))
 212 ;        (classes (car paths-parents-cons))
 213 ;        (parents (cdr paths-parents-cons))
 214 ;        (paths-key class-path)
 215 ;        (path-htable (br-get-htable (if lib-table-p "lib-paths" "sys-paths")))
 216 ;        (par-htable (br-get-htable
 217 ;                      (if lib-table-p "lib-parents" "sys-parents")))
 218 ;        (child-htable (br-get-children-htable)))
 219 ;    (mapcar
 220 ;      (function
 221 ;       (lambda (class)
 222 ;         (br-add-to-paths-htable class paths-key path-htable)))
 223 ;      classes)
 224 ;    (mapcar
 225 ;      (function
 226 ;       (lambda (parent-cons)
 227 ;         (hash-add (car parent-cons) (cdr parent-cons) par-htable)))
 228 ;      parents)
 229 ;    (br-env-set-htables t)
 230 ;    (let ((child) (par-list) children)
 231 ;      (mapcar
 232 ;       (function
 233 ;         (lambda (parent-cons)
 234 ;           (setq child (cdr parent-cons)
 235 ;                 par-list (car parent-cons))
 236 ;           (mapcar
 237 ;             (function
 238 ;               (lambda (parent)
 239 ;                 (setq children (hash-get parent child-htable))
 240 ;                 (or (br-member child children)
 241 ;                     (hash-add (cons child children) parent child-htable))))
 242 ;             par-list)))
 243 ;       parents)))
 244 ;  (cond ((eq save-file nil))
 245 ;       ((eq save-file t) (br-env-save))
 246 ;       ((br-env-save save-file))))
 247
 248 (defun br-ancestors (&optional arg features-string concrete-classes-flag)
 249   "Display ancestor tree whose root is the current class.
 250 With optional prefix ARG, display all ancestor trees whose roots are in the
 251 current listing.  With no ARG or if ARG = -1 or `br-invert-ancestors' is t,
 252 the current class ancestry tree is inverted.  That is, it shows branches
 253 going down towards the root class, so that parents appear above children.  If
 254 ARG < -1 or `br-invert-ancestors' is t and ARG > 1, then the ancestry trees
 255 of all classes in the current listing are inverted.
 256
 257 Optional second argument, FEATURES-STRING, is the plural name of the type of
 258 features to display along with each ancestor class.
 259
 260 CONCRETE-CLASSES-FLAG non-nil means omit abstract classes from the tree."
 261   (interactive "p")
 262   (or arg (setq arg 1))
 263   (if br-invert-ancestors (setq arg (- arg)))
 264   (let* ((class-list
 265           (if (and (/= arg 1) (/= arg -1))
 266               (br-this-level-classes)
 267             (br-find-class-name-as-list)))
 268          (parents (delq nil (mapcar (function
 269                                      (lambda (c) (br-get-parents c)))
 270                                     class-list))))
 271     (cond ((and class-list
 272                 (or parents
 273                     (and features-string
 274                          (if (/= 1 (length class-list))
 275                              t;; Assume some class will have features.
 276                            ;; This class must have features.
 277                            (br-list-features (car class-list))))))
 278            (if (and (/= arg 1) (/= arg -1))
 279                (message "Computing %s..."
 280                         (or features-string "ancestors")))
 281            (br-setup-next-window (if features-string
 282                                      (substring features-string 0 1)
 283                                    ;; ancestors
 284                                    "a"))
 285            (let (buffer-read-only)
 286              (cond ((>= arg 0)
 287                     (br-ancestor-trees class-list nil nil
 288                                        concrete-classes-flag))
 289                    (t
 290                     (br-ancestor-trees-inverted class-list nil nil
 291                                                 concrete-classes-flag))))
 292            (goto-char (point-min))
 293            (if (and (/= arg 1) (/= arg -1))
 294                (message "Computing %s...Done"
 295                         (or features-string "ancestors")))
 296            t)
 297           ((null class-list)
 298            (message "(OO-Browser):  Apply `br-%s' to a class."
 299                     (or features-string "ancestors"))
 300            (beep))
 301           (t
 302            (message "No %s." (or features-string "ancestors"))
 303            (beep)))))
 304
 305 (defun br-at (&optional arg)
 306   "Display the current class location in the inheritance graph.
 307 The class is displayed among both its ancestors and descendants.
 308 With optional prefix ARG, display the locations for all classes in the
 309 current listing."
 310   (interactive "P")
 311   (let* ((parent)
 312          (parent-list
 313            (if arg
 314                (br-this-level-classes)
 315              (list (setq parent (br-find-class-name))))))
 316     (if arg (message "Computing class locations..."))
 317     (br-setup-next-window "@")
 318     (let (buffer-read-only)
 319       (br-descendant-trees (br-ancestor-roots parent-list))
 320       (goto-char (point-min))
 321       (if arg
 322           (message "Computing class locations...Done")
 323         (re-search-forward (concat "\\(^\\|[ \t]+\\)" parent "$"))
 324         (goto-char (match-end 1))
 325         (recenter '(4))))))
 326
 327 (defun br-attributes (arg)
 328   "Display attributes of the current class (prefix ARG = 1) or of the current listing if ARG is other than 0 or 1.
 329
 330 With ARG = 0, the value of the variable, `br-inherited-features-flag', is
 331 toggled and no other action is taken.
 332
 333 If `br-inherited-features-flag' is t, all attributes of each class are shown.
 334 If nil, only lexically included attributes are shown and if the attributes of a
 335 single class are requested and none are defined, the class definition is
 336 displayed so that its attribute declarations may be browsed."
 337   (interactive "p")
 338   (cond ((and (integerp arg) (= arg 0))
 339          (setq br-inherited-features-flag
 340                (not br-inherited-features-flag))
 341          (message "Inherited features/elements will %sbe shown."
 342                   (if br-inherited-features-flag "" "not ")))
 343         (br-inherited-features-flag
 344          (br-inherited-attributes arg))
 345         (t (br-lexical-attributes arg))))
 346
 347 (defun br-categories (&optional arg)
 348   "Display categories directly associated with the current class.
 349 This does not include any categories which the class inherits.
 350 With optional prefix ARG, display categories of all classes in the current
 351 listing."
 352   (interactive "P")
 353   (let ((has-categories)
 354         class-list categories class-and-categories)
 355     (setq class-list (cond (arg
 356                             (message "Computing class categories...")
 357                             (br-this-level-classes))
 358                            (t
 359                             (br-find-class-name-as-list)))
 360           categories
 361           (delq nil (mapcar
 362                      (function
 363                       (lambda (class)
 364                         (setq class-and-categories (br-list-categories class)
 365                               has-categories (or has-categories
 366                                                  class-and-categories))
 367                         (cons class class-and-categories)))
 368                      class-list)))
 369     (cond ((not class-list)
 370            (message "(OO-Browser):  Apply `br-categories' to a class.") (beep))
 371           ((not has-categories)
 372            (message "No class categories.") (beep))
 373           (t
 374            (br-setup-next-window "C")
 375            (let (buffer-read-only done-set class)
 376              (mapcar
 377               (function
 378                (lambda (class-and-categories)
 379                  (setq class (car class-and-categories))
 380                  (if (not (br-set-cons done-set class))
 381                      (insert class " ...\n")
 382                    ;; Class successfully added to set, so it has not been
 383                    ;; listed before.
 384                    (insert class "\n")
 385                    (br-insert-features (cdr class-and-categories) 2))))
 386               categories))
 387            (message "Computing class categories...Done")
 388            (goto-char (point-min))
 389            t))))
 390
 391 (defun br-children (&optional arg)
 392   "Display the children of the current class.
 393 With optional prefix ARG, display the children of all the classes in the current
 394 listing."
 395   (interactive "P")
 396   (let ((class-list (cond (arg
 397                            (message "Computing children...")
 398                            (br-this-level-classes))
 399                           (t
 400                            (br-find-class-name-as-list))))
 401         (has-children)
 402         children children-list)
 403     (setq children-list (delq nil (mapcar
 404                                    (function
 405                                     (lambda (parent)
 406                                       (setq children
 407                                             (br-get-children parent)
 408                                             has-children
 409                                             (or has-children children))
 410                                       (cons parent children)))
 411                                    class-list)))
 412     (cond ((not children-list)
 413            (message "(OO-Browser):  Apply `br-children' to a class.")
 414            (beep))
 415           ((not has-children)
 416            (message "No children.") (beep))
 417           (t
 418            (br-setup-next-window "c")
 419            (let (buffer-read-only done-set parent)
 420              (mapcar
 421               (function
 422                (lambda (parent-children-cons)
 423                  (setq parent (car parent-children-cons))
 424                  (if (not (br-set-cons done-set parent))
 425                      (insert parent " ...\n")
 426                    ;; Class successfully added to set, so it has not been
 427                    ;; listed before.
 428                    (insert parent "\n")
 429                    (br-insert-classes (cdr parent-children-cons) 2))))
 430               children-list))
 431            (if arg (message "Computing children...Done"))
 432            (goto-char (point-min))
 433            t))))
 434
 435 (defun br-class-stats (&optional prompt)
 436   "Display a statistics summary for current class.
 437 Optional prefix arg PROMPT means prompt for a class name."
 438   (interactive "P")
 439   (let ((class-name (if prompt (br-complete-class-name) (br-find-class-name))))
 440     (if class-name
 441         (message "Class %s:  Parents: %d; Children: %d"
 442                  class-name (length (br-get-parents class-name))
 443                  (length (br-get-children class-name)))
 444       (error "No class name at point."))))
 445
 446 (defun br-cmd-help (key &optional full)
 447   "Show first line of doc for OO-Browser KEY in minibuffer.
 448 With optional FULL, display full documentation for command."
 449   (interactive "kOO-Browser key binding: \nP")
 450   (let* ((cmd (let ((cmd (if (eq major-mode 'br-mode)
 451                              (lookup-key br-mode-map key)
 452                            (key-binding key))))
 453                 (if (not (integerp cmd)) cmd)))
 454          (doc (and cmd (documentation cmd)))
 455          (end-line))
 456     (if doc
 457         (or full
 458             (setq end-line (string-match "[\n]" doc)
 459                   doc (substitute-command-keys (substring doc 0 end-line))))
 460       (setq doc (format "No documentation for {%s} %s" key (or cmd ""))))
 461     (if (and cmd doc)
 462         (if full
 463             (progn (br-to-view-window)
 464                    (other-window -1)
 465                    (describe-function cmd))
 466           (message doc)))))
 467
 468 (defun br-count ()
 469   "Count the number of entries visible in current listing buffer.
 470 Print the text result in the minibuffer when called interactively."
 471   (interactive)
 472   (let ((cnt (count-lines (point-min) (point-max))))
 473     (if (interactive-p)
 474         (message "%s contains %d entries." (buffer-name) cnt)
 475       cnt)))
 476
 477 (defun br-copyright ()
 478   "Display the OO-Browser copyright information in the viewer window."
 479   (interactive)
 480   (br-file-to-viewer "BR-COPY"))
 481
 482 (defun br-delete (&optional prompt)
 483   "Delete a class from the current Environment.
 484 Does not alter descendency relations.
 485 Optional prefix arg PROMPT means prompt for the class name."
 486   (interactive "P")
 487   (let ((class (if prompt (br-complete-class-name) (br-find-class-name))))
 488     (and class
 489          (if (interactive-p)
 490              (y-or-n-p (concat "Delete class " class " from Environment? "))
 491            t)
 492          (progn (br-real-delete-class class)
 493                 ;; Delete class name at point in listing window
 494                 (or prompt (let (buffer-read-only)
 495                              (progn (beginning-of-line)
 496                                     (delete-region
 497                                      (point) (progn (forward-line 1)
 498                                                     (point))))))
 499                 (message "Class " class " deleted.")))))
 500
 501 (defun br-descendants (&optional arg)
 502   "Display the descendant tree whose root is the current class.
 503 With optional prefix ARG, display all descendant trees whose roots are
 504 the classes in the current listing."
 505   (interactive "P")
 506   (let ((parent-list
 507          (if arg
 508              (br-this-level-classes)
 509            (br-find-class-name-as-list))))
 510     (cond ((delq nil (mapcar
 511                       (function (lambda (parent)
 512                                   (br-get-children parent)))
 513                       parent-list))
 514            (if arg (message "Computing descendants..."))
 515            (br-setup-next-window "d")
 516            (let (buffer-read-only)
 517              (br-descendant-trees parent-list))
 518            (goto-char (point-min))
 519            (if arg (message "Computing descendants...Done"))
 520            t)
 521           (t
 522            (message "No descendants.") (beep)))))
 523
 524 (defun br-edit-entry (&optional prompt)
 525   "Edit the source code for any browser listing entry, such as a class or a feature.
 526 Optional prefix arg PROMPT means prompt for the entry name; automatically
 527 prompts if called interactively outside of a listing window, e.g. within a
 528 source code buffer when the browser user interface is not displayed."
 529   (interactive "P")
 530   (let ((entry) (feature-tag))
 531     (if (or prompt (and (interactive-p) (not (br-in-browser))))
 532         (cond ((and (setq entry (br-complete-entry))
 533                     (string-match br-feature-signature-regexp entry))
 534                (if (setq feature-tag (car (br-feature-tag-and-file entry)))
 535                    (br-feature nil feature-tag)
 536                  (error "(br-feature-tag-and-file): Could not find match for: `%s'" entry)))
 537               (entry  ;; class name
 538                 (br-edit nil entry))
 539               (t (error "(br-complete-entry): Exited without selecting a match")))
 540       (cond ((br-at-feature-p)
 541              (br-feature)
 542              t)
 543             ((and (setq entry (br-find-class-name))
 544                   (br-class-in-table-p entry))
 545              (br-edit nil entry))
 546             (t (error "(OO-Browser):  No `%s' entry in the current Environment"
 547                       entry))))))
 548
 549 (defun br-edit (&optional prompt class)
 550   "Edit a class in the viewer window.
 551 Select viewer window.  With optional prefix arg PROMPT, prompt for class
 552 name.  Optional CLASS is the one to edit.  Return t if class is displayed or
 553 sent to an external viewer, else nil."
 554   (interactive "P")
 555   (or br-editor-cmd
 556       (not (br-in-browser))
 557       (br-in-view-window-p)
 558       (setq *br-prev-listing-window* (selected-window)))
 559   (br-view prompt t class))
 560
 561 (defun br-edit-ext (editor-cmd file line-num)
 562   "Invoke a non-standard EDITOR-CMD on FILE at LINE-NUM.
 563 See also `br-editor-cmd'."
 564   (interactive "fFile to edit: ")
 565   (or editor-cmd (setq editor-cmd br-editor-cmd))
 566   (if (not (stringp editor-cmd))
 567       ;; must be a Lisp function that takes two args, a file and line number
 568       (funcall editor-cmd file line-num)
 569     (setq delete-exited-processes t)
 570     (let ((proc)
 571           (name (concat br-ed-name (int-to-string br-ed-num))))
 572       (setq br-ed-num (1+ br-ed-num)
 573             proc (br-edit-ext-start editor-cmd name file line-num))
 574       (if proc
 575           (process-kill-without-query proc)
 576         (beep)
 577         (message "(OO-Browser):  Could not start external edit process: %s"
 578                  editor-cmd)))))
 579
 580 (defun br-editor-kill ()
 581   "Kill all current external editor sub-processes."
 582   (interactive)
 583   (if (br-kill-process-group br-ed-name br-ed-num "external editors")
 584       (setq br-ed-num 0)))
 585
 586 (defun br-entry-info ()
 587   "Display in the viewer window documentation for the current listing entry."
 588   (interactive)
 589   (if (fboundp 'br-insert-entry-info)
 590
 591       ;; For languages which use the newer entry-info functions.
 592       (if (looking-at ".")
 593           (progn
 594             (message "Building entry info...")
 595             (if (br-store-entry-info)
 596                 (progn (message "Building entry info...Done")
 597                        (br-funcall-in-view-window
 598                         (concat br-buffer-prefix-info "Info*")
 599                         'br-insert-entry-info))
 600               (beep)
 601               (message "There is no documentation for `%s'."
 602                        (br-feature-name (br-feature-entry)))))
 603         (beep)
 604         (message "Move point to the beginning of an entry name line."))
 605
 606     ;; For languages which use the older class-info functions.
 607     (let ((class-name (br-find-class-name)))
 608       (if class-name
 609           (if (fboundp 'br-insert-class-info)
 610               (progn
 611                 (message "Building `%s' class info..." class-name)
 612                 (if (br-store-class-info class-name)
 613                     (progn
 614                       (message "Building `%s' class info...Done" class-name)
 615                       (br-funcall-in-view-window
 616                        (concat br-buffer-prefix-info "Info*")
 617                        'br-insert-class-info))
 618                   (beep)
 619                   (message "There is no documentation for `%s'." class-name)))
 620             (beep)
 621             (message "No class information function for this language."))
 622         (beep)
 623         (message "No entry information function for this language.")))))
 624
 625 (defun br-exit-level (arg)
 626   "Return to prefix ARGth previous OO-Browser listing level.
 627 The command is ignored with ARG < 1."
 628   (interactive "p")
 629   (setq arg (or arg 1))
 630   (let ((prev-wind-buf-line))
 631     (if (null *br-level-hist*)
 632         (and (> arg 0)
 633              (message "No previous level to which to exit.")
 634              (beep))
 635       (while (and (> arg 0) *br-level-hist*)
 636         (br-next-buffer
 637          (int-to-string (br-listing-window-num)) br-buffer-prefix-blank)
 638         (setq prev-wind-buf-line (car *br-level-hist*)
 639               *br-level-hist* (cdr *br-level-hist*)
 640               arg (1- arg))
 641         (select-window (car prev-wind-buf-line))
 642         (switch-to-buffer (car (cdr prev-wind-buf-line))))
 643       (widen)
 644       ;; Position window lines exactly as before.
 645       (recenter (car (cdr (cdr prev-wind-buf-line)))))))
 646
 647 (defun br-feature (&optional view-only feature-tag)
 648   "Edit a feature in the viewer window.  Select viewer window.
 649 Optional VIEW-ONLY non-nil means view rather than edit feature.
 650 Optional FEATURE-TAG includes the signature of the feature to edit."
 651   (interactive)
 652   (or feature-tag
 653       ;; Get current feature tag
 654       (setq feature-tag (br-feature-get-tag)))
 655   (if (null feature-tag)
 656       (error "(br-feature): No definition for this entry")
 657     (let ((feature-sig
 658            (if (br-feature-tag-p feature-tag)
 659                (br-feature-tag-signature feature-tag)
 660              feature-tag)))
 661       (cond ((and (or (and (not view-only) (br-edit-externally-p))
 662                       (and view-only (br-view-externally-p)))
 663                   (let* ((func (function
 664                                 (lambda (path unused)
 665                                   (set-buffer (find-file-noselect path)))))
 666                          (br-edit-file-function func)
 667                          (br-view-file-function func)
 668                          (file (br-feature-tag-path feature-tag))
 669                          (line-num (save-excursion
 670                                      (br-feature-found-p file feature-tag))))
 671                     (and line-num
 672                          (funcall (if view-only 'br-view-externally
 673                                     'br-edit-externally)
 674                                   file line-num)))))
 675             ((progn
 676                (br-to-view-window)
 677                (br-feature-found-p (br-feature-tag-path feature-tag) feature-tag))
 678              (if view-only
 679                  (progn (setq buffer-read-only t)
 680                         (br-to-from-viewer))
 681                (if (and buffer-file-name (file-writable-p buffer-file-name))
 682                    (setq buffer-read-only nil))))
 683             ;;
 684             ;; Feature not found.  Return to original window and signal an error.
 685             (t (br-to-from-viewer)
 686                (error "(br-feature): Cannot find definition of: `%s'" feature-sig))))))
 687
 688 (defun br-features (arg)
 689   "List features/elements of the current class (prefix ARG = 1) or of the current listing if ARG is other than 0 or 1.
 690
 691 With ARG = 0, the value of the variable, `br-inherited-features-flag', is
 692 toggled and no other action is taken.
 693
 694 If `br-inherited-features-flag' is t, all features of each class are shown.
 695 If nil, only lexically included features are shown and if the features of a
 696 single class are requested and none are defined, the class definition is
 697 displayed so that its feature declarations may be browsed."
 698   (interactive "p")
 699   (cond ((and (integerp arg) (= arg 0))
 700          (setq br-inherited-features-flag
 701                (not br-inherited-features-flag))
 702          (message "Inherited features/elements will %sbe shown."
 703                   (if br-inherited-features-flag "" "not ")))
 704         (br-inherited-features-flag
 705          (br-inherited-features arg))
 706         (t (br-lexical-features arg))))
 707
 708 ;; Used outside of the browser user interface to display classes and features.
 709 (defun br-find ()
 710   "Prompt with completion for a class or element name from the current Environment and display its definition for editing."
 711   (interactive)
 712   (br-edit-entry t))
 713
 714 (defun br-help (&optional file)
 715   "Display OO-Browser operation help information in the viewer window."
 716   (interactive)
 717   (or file (setq file "br-help"))
 718   (br-file-to-viewer file)
 719   (save-window-excursion
 720     (br-to-view-window)
 721     (br-mode)
 722     (use-local-map nil))
 723   (message ""))
 724
 725 (defun br-help-ms ()
 726   "Display OO-Browser mouse usage help information in the viewer window."
 727   (interactive)
 728   (br-help "br-help-ms"))
 729
 730 (defun br-implementors (&optional arg)
 731   "Display a list of classes which contain definitions for the current element name.
 732 Ignore classes which inherit such definitions.  With optional prefix ARG,
 733 display implementors of all elements within the current listing."
 734   (interactive "P")
 735   (let* ((interfaces-p (br-interface-support-p))
 736          (categories-p (string-equal br-lang-prefix "objc-"))
 737          (feature-regexp (concat "\\`" br-feature-type-regexp " "))
 738          (class)
 739          (tag)
 740          (entries (if arg (br-this-level-entries)
 741                     (cond ((and (br-at-feature-p)
 742                                 (setq tag (br-feature-get-tag)
 743                                       class (br-feature-tag-class tag))
 744                                 (not (br-member class '("[module]" "[package]"))))
 745                            (list (br-find-feature-entry)))
 746                           ((or (br-at-protocol-p) (br-at-class-category-p))
 747                            (br-find-class-name-as-list))
 748                           ;; ignore classes, packages and modules
 749                           (t nil)))))
 750     (if (or (null entries) (null (car entries)))
 751         (error
 752          "(OO-Browser):  Apply `br-implementors' to a feature%s%s."
 753          (if interfaces-p " or an interface/protocol" "")
 754          (if categories-p " or a category" ""))
 755       (message "Computing implementors...")
 756       (br-setup-next-window "I")
 757       (let ((buffer-read-only) (implementor-tags) (classes)
 758             (categories)
 759             entry-category
 760             class
 761             start)
 762         (widen)
 763         (erase-buffer)
 764         (mapcar (function
 765                  (lambda (entry)
 766                    (cond
 767                     ;; features
 768                     ((string-match feature-regexp entry)
 769                      (setq implementor-tags
 770                            (br-feature-implementors
 771                             (br-feature-name entry)))
 772                      ;; Might contain invalid matches from a default class
 773                      ;; like [constant] (#define entry), so eliminate any
 774                      ;; such matches.
 775                      (if (br-member br-lang-prefix '("c++-" "java-" "objc-" "python-"))
 776                          (setq implementor-tags
 777                                (delq nil
 778                                      (mapcar
 779                                       (function
 780                                        (lambda (tag)
 781                                          (setq class (br-feature-tag-class tag))
 782                                          (if (and (br-default-class-p
 783                                                    (br-feature-tag-class
 784                                                    tag))
 785                                                   (not (string-equal class "[function]")))
 786                                              nil
 787                                            tag)))
 788                                       implementor-tags))))
 789                      ;; Sort tags
 790                      (setq implementor-tags
 791                            (br-feature-tag-sort-list implementor-tags))
 792                      ;; Get classes from tags
 793                      (setq classes (mapcar 'br-feature-tag-class
 794                                            implementor-tags))
 795                      (if (equal (string-match br-feature-type-regexp entry) 0)
 796                          (insert (substring entry 0 2)
 797                                  (br-feature-name entry)
 798                                  "\n")
 799                        (insert entry "\n"))
 800                      (setq start (point))
 801                      (br-insert-classes classes 4)
 802                      (save-excursion
 803                        (goto-char start)
 804                        (br-feature-put-tags implementor-tags)))
 805                     ;;
 806                     ;; interfaces/protocols
 807                     ((and interfaces-p (eq (aref entry 0) ?\<))
 808                      (br-insert-protocol-implementors
 809                       (list entry) 0))
 810                     ;;
 811                     ;; Objective-C class categories
 812                     ((setq entry-category (br-class-category-p entry))
 813                      (if (null categories)
 814                          (setq categories
 815                                (mapcar 'br-feature-signature-to-name
 816                                        (br-list-features
 817                                         objc-default-category-class))
 818                                ;; Set to t if there are no categories so that
 819                                ;; we don't recompute the set of categories
 820                                ;; for each entry.
 821                                categories (or categories t)))
 822                      (setq classes (objc-list-category-classes
 823                                     entry-category categories))
 824                      (insert entry-category "\n")
 825                      (setq start (point))
 826                      (br-insert-classes classes 2))
 827                     ;;
 828                     ;; ignore other kinds of entries
 829                     (t))))
 830                 entries))
 831       (goto-char 1)
 832       (message "Computing implementors...Done"))))
 833
 834 (defun br-info-language-specific ()
 835   "Display the OO-Browser manual section of specifics for the language of the current Environment."
 836   (interactive)
 837   (let ((lang-name (cdr (assoc br-lang-prefix br-env-lang-name-alist))))
 838     (if lang-name
 839         (id-info (concat "(oo-browser)"
 840                          lang-name " Specifics"))
 841       (error "(OO-Browser):  Invalid language prefix, `%s'" br-lang-prefix))))
 842
 843 (defun br-inherited-attributes (arg)
 844   "Display attributes declared within a class, including those from ancestors.
 845 With optional prefix ARG, display attributes of all classes in the current
 846 listing."
 847   (interactive "p")
 848   (let ((br-ancestor-function
 849          (function
 850           (lambda (class repeated-class indent)
 851             (if repeated-class
 852                 nil
 853               (br-insert-features
 854                (br-feature-list-attributes class) indent))))))
 855     (br-ancestors arg "attributes" nil)))
 856
 857 (defun br-inherited-features (arg)
 858   "Display class features, including those from ancestors.
 859 With optional prefix ARG, display features of all classes in the current
 860 listing."
 861   (interactive "p")
 862   (let ((br-ancestor-function
 863          (function
 864           (lambda (class repeated-class indent)
 865             (if repeated-class
 866                 nil
 867               (br-insert-features (br-list-features class indent) indent))))))
 868     ;; Features of abstract classes are implemented by their
 869     ;; descendants so we don't want to show these feature
 870     ;; names a second time within the inheritance lattice.  The third
 871     ;; argument to this next call suppresses listing of inherited abstract
 872     ;; classes and their features except in cases where the class itself is
 873     ;; abstract.
 874     (br-ancestors arg "features" t)))
 875
 876 (defun br-inherited-routines (arg)
 877   "Display class routines, including those from ancestors.
 878 With optional prefix ARG, display routines of all classes in the current
 879 listing."
 880   (interactive "p")
 881   (let ((br-ancestor-function
 882          (function
 883           (lambda (class repeated-class indent)
 884             (if repeated-class
 885                 nil
 886               (br-insert-features
 887                (br-feature-list-routines class) indent))))))
 888     ;; Routines of abstract classes are implemented by their
 889     ;; descendants so we don't want to show these routine
 890     ;; names a second time within the inheritance lattice.  The third
 891     ;; argument to this next call suppresses listing of inherited abstract
 892     ;; classes and their routines except in cases where the class itself is
 893     ;; abstract.
 894     (br-ancestors arg "routines" t)))
 895
 896 (defun br-kill ()
 897   "Kill buffer in the viewer window and redisplay help text."
 898   (interactive)
 899   (br-do-in-view-window '(progn (kill-buffer nil) (br-help))))
 900
 901 (defun br-lexical-attributes (arg)
 902   "Display class attributes lexically defined within current class.
 903 With numeric prefix ARG, display attributes of all classes in the current
 904 listing."
 905   (interactive "p")
 906   (let ((has-attributes)
 907         class-list attribute-list class-and-attributes)
 908     (setq class-list (cond ((and (integerp arg) (/= arg 1))
 909                             (message "Computing class attributes...")
 910                             (br-this-level-classes))
 911                            (t
 912                             (br-find-class-name-as-list)))
 913           attribute-list
 914           (delq nil (mapcar
 915                      (function
 916                       (lambda (class)
 917                         (setq class-and-attributes
 918                               (br-feature-list-attributes class)
 919                               has-attributes (or has-attributes
 920                                                class-and-attributes))
 921                         (cons class class-and-attributes)))
 922                      class-list)))
 923     (cond ((not class-list)
 924            (beep)
 925            (message "(OO-Browser):  Apply `br-attributes' to a class."))
 926           ((not has-attributes)
 927            (message "No attributes declared for the class%s."
 928                     (if (= (length class-list) 1) "" "es"))
 929            (beep))
 930           (t
 931            (br-add-level-hist)
 932            (br-next-buffer)
 933            (let (buffer-read-only done-set class)
 934              (mapcar
 935               (function
 936                (lambda (class-and-attributes)
 937                  (setq class (car class-and-attributes))
 938                  (if (not (br-set-cons done-set class))
 939                      (insert class " ...\n")
 940                    ;; Class successfully added to set, so it has not been
 941                    ;; listed before.
 942                    (insert class "\n")
 943                    (br-insert-features (cdr class-and-attributes) 2))))
 944               attribute-list)
 945              (message "Computing class attributes...Done")
 946              (goto-char (point-min)))))))
 947
 948 (defun br-lexical-features (arg)
 949   "Display class features lexically defined within current class.
 950 With numeric prefix ARG, display features of all classes in the current
 951 listing.
 952
 953 If the features of a single class are requested and there are no feature
 954 definitions for the class, display the class definition so that its feature
 955 declarations may be browsed."
 956   (interactive "p")
 957   (let ((has-features)
 958         class-list feature-list class-and-features)
 959     (setq class-list (cond ((and (integerp arg) (/= arg 1))
 960                             (message "Computing class features...")
 961                             (br-this-level-classes))
 962                            (t
 963                             (br-find-class-name-as-list)))
 964           feature-list
 965           (delq nil (mapcar
 966                      (function
 967                       (lambda (class)
 968                         (setq class-and-features (br-list-features class)
 969                               has-features (or has-features
 970                                                class-and-features))
 971                         (cons class class-and-features)))
 972                      class-list)))
 973     (cond ((not class-list)
 974            (beep)
 975            (message "(OO-Browser):  Apply `br-features' to a class."))
 976           ((not has-features)
 977            (if (and (= (length class-list) 1)
 978                     (br-class-path (car class-list)))
 979                (if (br-view nil nil (car class-list))
 980                    (message
 981                     "No feature definitions, browse declarations instead."))
 982              (message "No class features.") (beep)))
 983           (t
 984            (br-add-level-hist)
 985            (br-next-buffer)
 986            (let (buffer-read-only done-set class)
 987              (mapcar
 988               (function
 989                (lambda (class-and-features)
 990                  (setq class (car class-and-features))
 991                  (if (not (br-set-cons done-set class))
 992                      (insert class " ...\n")
 993                    ;; Class successfully added to set, so it has not been
 994                    ;; listed before.
 995                    (insert class "\n")
 996                    (br-insert-features (cdr class-and-features) 2))))
 997               feature-list)
 998              (message "Computing class features...Done")
 999              (goto-char (point-min)))))))
1000
1001 (defun br-lexical-routines (arg)
1002   "Display class routines lexically defined within current class.
1003 With numeric prefix ARG, display routines of all classes in the current
1004 listing.
1005
1006 If the routines of a single class are requested and there are no routine
1007 definitions for the class, display the class definition so that its routine
1008 declarations may be browsed."
1009   (interactive "p")
1010   (let ((has-routines)
1011         class-list routine-list class-and-routines)
1012     (setq class-list (cond ((and (integerp arg) (/= arg 1))
1013                             (message "Computing class routines...")
1014                             (br-this-level-classes))
1015                            (t
1016                             (br-find-class-name-as-list)))
1017           routine-list
1018           (delq nil (mapcar
1019                      (function
1020                       (lambda (class)
1021                         (setq class-and-routines
1022                               (br-feature-list-routines class)
1023                               has-routines (or has-routines
1024                                                class-and-routines))
1025                         (cons class class-and-routines)))
1026                      class-list)))
1027     (cond ((not class-list)
1028            (beep)
1029            (message "(OO-Browser):  Apply `br-routines' to a class."))
1030           ((not has-routines)
1031            (if (and (= (length class-list) 1)
1032                     (br-class-path (car class-list)))
1033                (if (br-view nil nil (car class-list))
1034                    (message
1035                     "No routine definitions, browse declarations instead."))
1036              (message "No class routines.") (beep)))
1037           (t
1038            (br-add-level-hist)
1039            (br-next-buffer)
1040            (let (buffer-read-only done-set class)
1041              (mapcar
1042               (function
1043                (lambda (class-and-routines)
1044                  (setq class (car class-and-routines))
1045                  (if (not (br-set-cons done-set class))
1046                      (insert class " ...\n")
1047                    ;; Class successfully added to set, so it has not been
1048                    ;; listed before.
1049                    (insert class "\n")
1050                    (br-insert-features (cdr class-and-routines) 2))))
1051               routine-list)
1052              (message "Computing class routines...Done")
1053              (goto-char (point-min)))))))
1054
1055 (defun br-lib-rebuild ()
1056   "Rescan Library components of the current Environment."
1057   (interactive)
1058   (if (call-interactively 'br-build-lib-htable)
1059       (br-show-all-classes)))
1060
1061 (defun br-lib-top-classes (&optional arg)
1062   "Display a list of the top-level Library classes.
1063 With prefix ARG, display all Library classes."
1064   (interactive "P")
1065   (and (or (not (interactive-p))
1066            (br-in-top-buffer-p)
1067            (y-or-n-p "Exit to top-level class listing buffer? "))
1068        (cond (arg
1069               (br-show-classes
1070                (function (lambda () (br-all-classes "lib")))
1071                nil t "Al")
1072               (message "Listing of all Library classes"))
1073              (t
1074               (br-show-classes 'br-get-lib-top-classes t t "Tl")
1075               (message "Listing of top-level Library classes")))
1076        (setq *br-level-hist* nil)))
1077
1078 (defun br-match (&optional expr arg again matched)
1079   "Show all class names in the current Environment that contain optional EXPR.
1080 A nil value of EXPR means prompt for a value.  With optional prefix ARG, EXPR
1081 is treated as a string.  By default, it is treated as a regular expression.
1082 AGAIN non-nil shows the number of classes MATCHED from the last search,
1083 allowing repeated narrowing of the search set.  An empty EXPR when AGAIN is
1084 nil matches to all classes in the Environment."
1085   (interactive (list nil current-prefix-arg))
1086   (or expr (setq expr (read-string
1087                        (concat (if again (format "(%s matches)  " matched))
1088                                (if arg
1089                                    "Find Environment class string matches"
1090                                  "Find Environment class regular expression matches")
1091                                (if again " (RET to end): " ": ")))))
1092   (if (and again (equal expr ""))
1093       nil
1094     (let* ((match-expr (if arg (regexp-quote expr) expr))
1095            (classes
1096             (delq nil (mapcar
1097                        (function
1098                         (lambda (cl)
1099                           (if (string-match match-expr cl) cl)))
1100                        (if again
1101                            (sort (br-this-level-classes) 'string-lessp)
1102                          (br-all-classes))))))
1103       (if classes
1104           (progn (let (buffer-read-only)
1105                    (br-feature-clear-tags)
1106                    (erase-buffer)
1107                    (br-insert-classes classes 0))
1108                  (goto-char (point-min))
1109                  (br-match nil arg t (br-count)))
1110         (beep)
1111         (message "No matches for \"%s\"." expr)))))
1112
1113 (defun br-match-entries (&optional expr arg again matched)
1114   "Show all entries in the current listing that contain optional EXPR.
1115 A nil value of EXPR means prompt for a value.  With optional prefix ARG, EXPR
1116 is treated as a string.  By default, it is treated as a regular expression.
1117 AGAIN non-nil means show the number of entries MATCHED from the last search,
1118 allowing repeated narrowing of the search set.  An empty EXPR when AGAIN is
1119 nil matches to all entries in the listing."
1120   (interactive (list nil current-prefix-arg))
1121   (or expr (setq expr (read-string
1122                         (concat (if again (format "(%s matches)  " matched))
1123                                 (if arg
1124                                     "Find string matches in listing"
1125                                   "Find regular expression matches in listing")
1126                                 (if again " (RET to end): " ": ")))))
1127   (if (and again (equal expr ""))
1128       nil
1129     (let* ((match-expr (if arg (regexp-quote expr) expr))
1130            (buffer-read-only))
1131       (goto-char (point-min))
1132       (if (not (re-search-forward match-expr nil t))
1133           (progn (beep)
1134                  (message "No matches for \"%s\"." expr))
1135         (goto-char (point-min))
1136         (delete-non-matching-lines match-expr)
1137         (goto-char (point-min))
1138         (br-match-entries nil arg t (br-count))))))
1139
1140 (defun br-next-entry (arg)
1141   "Move point vertically down prefix ARG number of lines in a listing buffer."
1142   (interactive "p")
1143   (let ((end))
1144     (setq end (= (forward-line arg) arg))
1145     (and (looking-at "^$") (forward-line -1) (setq end t))
1146     (and end (message "No next entry.") (beep))))
1147
1148 (defun br-order (arg)
1149   "Order current browser listing window entries.
1150 With prefix ARG other than 1 (the default), don't remove leading space from
1151 entry lines before ordering.  Negative ARG means order in descending Ascii
1152 sequence, otherwise order in ascending sequence."
1153   (interactive "p")
1154   (setq arg (or arg 1))
1155   (message "Ordering entries...")
1156   (let ((buffer-read-only)
1157         sort-args)
1158     (and (= arg 1) (progn (goto-char (point-min))
1159                           (while (re-search-forward "^[ \t]+" nil t)
1160                             (replace-match ""))))
1161     (if (string-lessp "19" emacs-version)
1162         (progn
1163           ;; Emacs 19: This is slower than calling an external sort but it
1164           ;; maintains the element tags in a listing, allowing further
1165           ;; browsing from this buffer.
1166           (sort-lines (< arg 0) (point-min) (point-max))
1167           ;; Move [default] classes to the end of the sorted list.
1168           (goto-char (point-min))
1169           (if (re-search-forward "^[ \t]*\\[" nil t)
1170               (let (start end)
1171                 (beginning-of-line)
1172                 (setq start (point))
1173                 (goto-char (point-max))
1174                 (re-search-backward "^[ \t]*\\[" nil t)
1175                 (forward-line 1)
1176                 (setq end (point))
1177                 (goto-char (point-max))
1178                 (append-to-buffer (current-buffer) start end)
1179                 (delete-region start end))))
1180       ;;
1181       ;; Emacs 18: We can't maintain the buffer tags, so we just use a fast
1182       ;; external sort.
1183       (setq sort-args (list (point-min) (point-max) "sort" t t nil)
1184             sort-args (if (< arg 0)
1185                           (if (stringp br-sort-options)
1186                               (nconc sort-args (list "-r" br-sort-options))
1187                             (nconc sort-args (list "-r")))
1188                         (if (stringp br-sort-options)
1189                             (nconc sort-args (list br-sort-options))
1190                           sort-args)))
1191       (apply 'call-process-region sort-args)))
1192   (goto-char (point-min))
1193   (message "Ordering entries...Done"))
1194
1195 (defun br-parents (&optional arg)
1196   "Display the parents of the current class.
1197 With optional prefix ARG, display parents of all the classes in the current
1198 listing."
1199   (interactive "P")
1200   (let ((class-list (cond (arg
1201                            (message "Computing parents...")
1202                            (br-this-level-classes))
1203                           (t
1204                            (br-find-class-name-as-list))))
1205         (has-parents)
1206         parents parents-list)
1207     (setq parents-list
1208           (delq nil (mapcar (function
1209                              (lambda (class)
1210                                (setq parents (br-get-parents class)
1211                                      has-parents (or has-parents parents))
1212                                (cons class parents)))
1213                             class-list)))
1214     (cond ((not parents-list)
1215            (message "(OO-Browser):  Apply `br-parents' to a class.") (beep))
1216           ((not has-parents)
1217            (message "No parents.") (beep))
1218           (t
1219            (br-setup-next-window "p")
1220            (let (buffer-read-only done-set class)
1221              (mapcar
1222               (function
1223                (lambda (class-parents-cons)
1224                  (setq class (car class-parents-cons))
1225                  (if (not (br-set-cons done-set class))
1226                      (insert class " ...\n")
1227                    ;; Class successfully added to set, so it has not been
1228                    ;; listed before.
1229                    (insert class "\n")
1230                    (br-insert-classes (cdr class-parents-cons) 2))))
1231               parents-list))
1232            (if arg (message "Computing parents...Done"))
1233            (goto-char (point-min))
1234            t))))
1235
1236 (defun br-prev-entry (arg)
1237   "Move point vertically up prefix ARG number of lines in a listing buffer."
1238   (interactive "p")
1239   (setq arg (- arg))
1240   (and (= (forward-line arg) arg)
1241        (message "No previous entry.")
1242        (beep)))
1243
1244 (defalias 'br-interfaces 'br-protocols)
1245
1246 (defun br-protocols (&optional arg)
1247   "Display the protocols to which the current class or protocol conforms, including inherited ones.
1248
1249 With optional prefix ARG (other than 0 or 1), display protocols of all
1250 classes and protocols in the current listing.
1251
1252 With ARG = 0, the value of the variable, `br-protocols-with-classes-flag', is
1253 toggled and no other action is taken."
1254   (interactive "P")
1255   (if (and (integerp arg) (= arg 0)
1256            (br-protocol-support-p))
1257       (progn
1258         (setq br-protocols-with-classes-flag
1259               (not br-protocols-with-classes-flag))
1260         (if br-protocols-with-classes-flag
1261             (message
1262              "Protocols/interfaces will %sbe included in initial class listings."
1263              (if br-protocols-with-classes-flag "" "not "))))
1264     (let* ((protocols-p (br-protocol-support-p))
1265            (class-list (if protocols-p
1266                            (cond (arg
1267                                   (message "Computing all class protocols...")
1268                                   (br-this-level-classes))
1269                                  (t
1270                                   (br-find-class-name-as-list))))))
1271       (cond ((not protocols-p)
1272              (beep)
1273              (message "(OO-Browser):  No protocol browsing support for this language"))
1274             ((not class-list)
1275              (beep)
1276              (message "(OO-Browser):  Apply `br-protocols' to a class."))
1277             (t
1278              (br-setup-next-window "P")
1279              (let (buffer-read-only)
1280                (br-ancestor-trees class-list))
1281              (message "Computing all class protocols...Done")
1282              (goto-char (point-min)))))))
1283
1284 (defun br-quit (&optional arg)
1285   "Quit the OO-Browser.
1286 With optional prefix ARG, delete window configurations and listing
1287 buffers associated with the browser."
1288   (interactive "P")
1289   (if (not (br-in-browser))
1290       (br-interrupt arg)
1291     (if (null arg)
1292         (setq *br-save-wconfig* (current-window-configuration))
1293       (if (featurep 'br-tree) (br-tree-kill))
1294       (br-viewer-kill)
1295       ;; Too dangerous to include (br-editor-kill) here.
1296       ;; The user can invoke it manually if desired.
1297       )
1298     ;; The following `let' clause is necessary since br-interrupt buries
1299     ;; buffers and so must be called before the window configuration restore,
1300     ;; but it also may set *br-prev-wconfig* to nil, so we have to cache its
1301     ;; value.
1302     (let ((wconfig *br-prev-wconfig*))
1303       (br-interrupt arg)
1304       (if wconfig (br-set-window-configuration wconfig)))
1305     (and (fboundp 'frame-name) (equal (frame-name) "OO-Browser")
1306          (if arg (delete-frame) (make-frame-invisible)))
1307     nil)
1308   ;; Force menubar update under GNU Emacs.
1309   (if (fboundp 'set-menubar-dirty-flag)
1310       (set-menubar-dirty-flag)))
1311
1312 (defun br-refresh ()
1313   "Restore the OO-Browser to its state upon startup."
1314   (interactive)
1315   (br-window-setup)
1316   (br-show-all-classes)
1317   (br-help)
1318   (setq br-in-browser (selected-frame)))
1319
1320 (defun br-report-bug ()
1321   "Send a message to the OO-Browser discussion list."
1322   (interactive)
1323   (if (br-in-browser) (br-to-view-window))
1324   (hmail:compose "oo-browser-bugs@xemacs.org" '(hypb:configuration)))
1325
1326 (defun br-routines (arg)
1327   "Display routines of the current class (prefix ARG = 1) or of the current listing if ARG is other than 0 or 1.
1328
1329 With ARG = 0, the value of the variable, `br-inherited-features-flag', is
1330 toggled and no other action is taken.
1331
1332 If `br-inherited-features-flag' is t, all routines of each class are shown.
1333 If nil, only lexically included routines are shown and if the routines of a
1334 single class are requested and none are defined, the class definition is
1335 displayed so that its routine declarations may be browsed."
1336   (interactive "p")
1337   (cond ((and (integerp arg) (= arg 0))
1338          (setq br-inherited-features-flag
1339                (not br-inherited-features-flag))
1340          (message "Inherited features/elements will %sbe shown."
1341                   (if br-inherited-features-flag "" "not ")))
1342         (br-inherited-features-flag
1343          (br-inherited-routines arg))
1344         (t (br-lexical-routines arg))))
1345
1346 (defun br-set-window-configuration (wconfig)
1347   "Restore a window configuration, if possible, protecting against errors.
1348 Return t if no error, nil otherwise."
1349   (condition-case ()
1350       (progn (set-window-configuration wconfig) t)
1351     (error nil)))
1352
1353 (defun br-sys-rebuild ()
1354   "Rescan System components of the current Environment."
1355   (interactive)
1356   (if (call-interactively 'br-build-sys-htable)
1357       (br-show-all-classes)))
1358
1359 (defun br-sys-top-classes (&optional arg)
1360   "Display list of top-level System classes.
1361 With prefix ARG, display all System classes."
1362   (interactive "P")
1363   (and (or (not (interactive-p))
1364            (br-in-top-buffer-p)
1365            (y-or-n-p "Exit to top-level class listing buffer? "))
1366        (cond (arg
1367               (br-show-classes
1368                (function (lambda () (br-all-classes "sys")))
1369                nil t "As")
1370               (message "Listing of all System classes"))
1371              (t
1372               (br-show-classes 'br-get-sys-top-classes t t "Ts")
1373               (message "Listing of top-level System classes")))
1374        (setq *br-level-hist* nil)))
1375
1376 ;;;###autoload
1377 (defun br-to-from-viewer ()
1378   "Move point to the viewer window or back to the last recorded listing window."
1379   (interactive)
1380   (if (br-in-view-window-p)
1381       (progn (if (and *br-prev-listing-window*
1382                       (if (fboundp 'window-live-p)
1383                           (window-live-p *br-prev-listing-window*)
1384                         t))
1385                  (select-window *br-prev-listing-window*)
1386                (other-window 1))
1387              (setq *br-prev-listing-window* nil))
1388     (br-to-view-window)))
1389
1390 (defun br-toggle-c-tags ()
1391   "Toggle the value of the `br-c-tags-flag' flag."
1392   (interactive)
1393   (setq br-c-tags-flag (not br-c-tags-flag))
1394   (message "C constructs will %sbe added to C-based language Environments."
1395            (if br-c-tags-flag "" "not ")))
1396
1397 (defun br-toggle-keep-viewed ()
1398   "Toggle the value of the `br-keep-viewed-classes' flag."
1399   (interactive)
1400   (setq br-keep-viewed-classes (not br-keep-viewed-classes))
1401   (message "Viewed buffers will no%s be kept after use."
1402            (if br-keep-viewed-classes "w" "t")))
1403
1404 (defun br-show-all-classes ()
1405   "Display list of all Environment classes."
1406   (interactive)
1407   (br-show-top-classes t))
1408
1409 (defun br-show-top-classes (&optional arg)
1410   "Display list of top-level classes.
1411 With prefix ARG, display all Environment classes."
1412   (interactive "P")
1413   (and (or (not (interactive-p))
1414            (br-in-top-buffer-p)
1415            (y-or-n-p "Exit to top-level class listing buffer? "))
1416        (cond (arg
1417               (br-show-classes 'br-all-classes nil t "A")
1418               (message "Listing of all Environment classes"))
1419              (t
1420               (br-show-classes 'br-get-top-classes t t "T")
1421               (message "Listing of top-level classes")))
1422        (setq *br-level-hist* nil)))
1423
1424 (defun br-unique ()
1425   "Eliminate adjacent duplicate entry names from the current listing window.
1426 If two adjacent entries look the same, one is eliminated, even if they refer
1427 to different class elements."
1428   (interactive)
1429   (let ((buffer-read-only)
1430         (again t)
1431         first second)
1432     (goto-char (point-min))
1433     (setq first (br-feature-current))
1434     (while again
1435       (setq again (= (forward-line 1) 0)
1436             second (br-feature-current))
1437       (if (not (string-equal first second))
1438           (setq first second)
1439         (beginning-of-line)
1440         (delete-region (point) (progn (forward-line 1) (point)))
1441         ;; back up to first line again
1442         (forward-line -1)))
1443     (goto-char (point-min))))
1444
1445 (defun br-version ()
1446   "Display the OO-Browser version number and credits."
1447   (interactive)
1448   (br-funcall-in-view-window
1449    (concat br-buffer-prefix-info "Help*")
1450    (function (lambda ()
1451                (insert-file-contents (br-pathname "BR-VERSION"))
1452                (hypb:display-file-with-logo)
1453                (if (re-search-forward "<VERSION>" nil t)
1454                    (replace-match br-version t t))
1455                (center-line)
1456                (set-buffer-modified-p nil)))))
1457
1458 (defun br-view-entry (&optional prompt)
1459   "Display source for any browser listing entry.
1460 Optional prefix arg PROMPT (if other than 0) means prompt for an entry name;
1461 automatically prompts if called interactively outside of a listing window,
1462 e.g. within a source code buffer when the browser user interface is not
1463 displayed.  With a prefix arg of 0, the value of the variable,
1464 `br-keep-viewed-classes', is toggled and no other action is taken."
1465   (interactive "P")
1466   (if (and (integerp prompt) (= prompt 0))
1467       (br-toggle-keep-viewed)
1468     (let ((entry) (feature-tag))
1469       (if (or prompt (and (interactive-p) (not (br-in-browser))))
1470           (cond ((and (setq entry (br-complete-entry))
1471                       (string-match br-feature-signature-regexp entry))
1472                  (if (setq feature-tag (car (br-feature-tag-and-file entry)))
1473                      (br-feature 'view feature-tag)
1474                    (error "(br-feature-tag-and-file): Could not find match for: `%s'" entry)))
1475                 (entry ;; class name
1476                  (br-view nil nil entry))
1477                 (t (error "(br-complete-entry): Exited without selecting a match")))
1478         (cond ((br-at-feature-p)
1479                (br-feature 'view)
1480                t)
1481               ((and (setq entry (br-find-class-name))
1482                     (br-class-in-table-p entry))
1483                (br-view nil nil entry))
1484               (t (error "(OO-Browser):  Entry may be referenced but not defined in the Environment.")))))))
1485
1486 (defun br-view (&optional prompt writable class)
1487   "Displays class file in viewer window.
1488 Optional prefix arg PROMPT means prompt for class name.  Non-nil WRITABLE means
1489 allow editing, otherwise display in read-only mode.  Non-nil CLASS is class to
1490 display.  Return t if class is displayed or sent to an external viewer, else nil."
1491   (interactive "P")
1492   (or class (setq class (if prompt (br-complete-class-name)
1493                           (br-find-class-name))))
1494   (cond ((null class)
1495          (beep)
1496          (message "(OO-Browser):  Select a class to view.")
1497          nil)
1498         ((not (br-class-defined-p class)) nil)
1499         ((and (or (and writable (br-edit-externally-p))
1500                   (and (not writable) (br-view-externally-p)))
1501               (let* ((func (function
1502                             (lambda (path unused)
1503                               (set-buffer (find-file-noselect path)))))
1504                      (br-edit-file-function func)
1505                      (br-view-file-function func)
1506                      (line-num (save-excursion
1507                                  (br-find-class class (not writable)))))
1508                 (and line-num
1509                      (funcall (if writable 'br-edit-externally 'br-view-externally)
1510                               (br-class-path class) line-num)))))
1511         (t (let ((owind (selected-window))
1512                  viewer-obuf)
1513              (unwind-protect
1514                  (progn (if (br-in-browser) (br-to-view-window))
1515                         (setq viewer-obuf (current-buffer))
1516                         (if (br-find-class class (not writable))
1517                             (progn
1518                               (if (not (eq (current-buffer) viewer-obuf))
1519                                   (save-excursion
1520                                     (set-buffer viewer-obuf)
1521                                     (if (and (not br-keep-viewed-classes)
1522                                              buffer-read-only
1523                                              (null (buffer-modified-p)))
1524                                         (kill-buffer (current-buffer)))))
1525                               t)))
1526                (or writable (select-window owind)))))))
1527
1528 (defun br-view-ext (viewer-cmd file line-num)
1529   "Invoke a non-standard VIEWER-CMD on FILE at LINE-NUM.
1530 See also `br-viewer-cmd'."
1531   (interactive "fFile to view: ")
1532   (or viewer-cmd (setq viewer-cmd br-viewer-cmd))
1533   (if (not (stringp viewer-cmd))
1534       ;; must be a Lisp function that takes two args, a file and line number
1535       (funcall viewer-cmd file line-num)
1536     (setq delete-exited-processes t)
1537     (let ((proc)
1538           (name (concat br-vw-name (int-to-string br-vw-num))))
1539       (setq br-vw-num (1+ br-vw-num)
1540             proc (br-view-ext-start viewer-cmd name file line-num))
1541       (if proc
1542           (process-kill-without-query proc)
1543         (beep)
1544         (message "(OO-Browser):  Could not start external view process: %s"
1545                   viewer-cmd)))))
1546
1547 (defun br-view-full-frame ()
1548   "Delete all windows in the selected frame except for the viewer window."
1549   (interactive)
1550   (setq *br-save-wconfig* (current-window-configuration))
1551   (br-to-view-window)
1552   (let ((buf (current-buffer)))
1553     (br-interrupt)
1554     (delete-other-windows)
1555     (switch-to-buffer buf))
1556   (let* ((cmd (concat br-lang-prefix "browse"))
1557          (key (car (where-is-internal (intern-soft cmd)))))
1558     (message "Recall OO-Browser with: {%s}"
1559              (if key
1560                  (key-description key)
1561                (concat (key-description
1562                         (or (car (where-is-internal
1563                                   'execute-extended-command))
1564                             "\M-x"))
1565                        " " cmd)))))
1566
1567 (defun br-viewer-scroll-down-by-line (arg)
1568   "Scroll the viewer window from within a listing window to show prefix ARG more prior lines (default is 1)."
1569   (interactive "p")
1570   (let ((owind (selected-window)))
1571     (unwind-protect
1572         (progn (br-to-view-window)
1573                (scroll-down arg))
1574       (select-window owind))))
1575
1576 (defun br-viewer-scroll-up-by-line (arg)
1577   "Scroll the viewer window from within a listing window to show prefix ARG more following lines (default is 1)."
1578   (interactive "p")
1579   (let ((owind (selected-window)))
1580     (unwind-protect
1581         (progn (br-to-view-window)
1582                (scroll-up arg))
1583       (select-window owind))))
1584
1585 (defun br-viewer-beginning-of-buffer ()
1586   "Scroll to the beginning of the viewer window buffer from within a listing window."
1587   (interactive)
1588   (let ((owind (selected-window)))
1589     (br-to-view-window)
1590     (beginning-of-buffer) ;; sets mark at prior location
1591     (select-window owind))
1592   (message "Beginning of buffer"))
1593
1594 (defun br-viewer-end-of-buffer ()
1595   "Scroll to the end of the viewer window buffer from within a listing window."
1596   (interactive)
1597   (let ((owind (selected-window)))
1598     (br-to-view-window)
1599     (end-of-buffer) ;; sets mark at prior location
1600     (select-window owind))
1601   (message "End of buffer"))
1602
1603 (defun br-viewer-kill ()
1604   "Kill all current external viewer sub-processes."
1605   (interactive)
1606   (if (br-kill-process-group br-vw-name br-vw-num "external viewers")
1607       (setq br-vw-num 0)))
1608
1609 (defun br-viewer-scroll-down (&optional arg)
1610   "Scroll the viewer window downward ARG lines or a windowful if no ARG."
1611   (interactive "P")
1612   (let ((owind (selected-window)))
1613     (unwind-protect
1614         (progn (br-to-view-window)
1615                (scroll-down arg))
1616       (select-window owind))))
1617
1618 (defun br-viewer-scroll-up (&optional arg)
1619   "Scroll the viewer window upward ARG lines or a windowful if no ARG."
1620   (interactive "P")
1621   (let ((owind (selected-window)))
1622     (unwind-protect
1623         (progn (br-to-view-window)
1624                (scroll-up arg))
1625       (select-window owind))))
1626
1627 (defun br-where (&optional prompt)
1628   "Display in the viewer window and return the full path of the defining file for a browser listing entry.
1629 Optional prefix arg PROMPT means prompt for the entry name; automatically
1630 prompts if called interactively outside of a listing window (in standalone
1631 mode), e.g. within a source code buffer when the browser user interface is
1632 not displayed.  If called in standalone mode with a prefix argument, the
1633 command inserts the defining path at point rather than displaying it elsewhere."
1634   (interactive "P")
1635   (let ((entry) (path) (tag)
1636         (standalone (and (interactive-p) (not (br-in-browser)))))
1637     (if (or prompt standalone)
1638         (cond ((and (setq entry (br-complete-entry))
1639                     (string-match br-feature-signature-regexp entry))
1640                (setq path (cdr (br-feature-tag-and-file entry))))
1641               (entry ;; class name
1642                (setq path (br-class-defined-p entry)))
1643               (t (error "(br-complete-entry): Exited without selecting a match")))
1644       (cond ((setq tag (br-feature-get-tag))
1645              (setq path (br-feature-tag-path tag))
1646              (if (equal br-lang-prefix "eif-")
1647                  (setq entry (br-feature-tag-name tag t))
1648                (setq entry (br-feature-tag-signature tag))
1649                (if (and entry (string-match "::" entry))
1650                    nil
1651                  (setq entry (concat (br-feature-tag-class tag) "::" entry)))
1652                ;; Remove any trailing \{.
1653                (if (string-match "\\s-*\{\\'" entry)
1654                    (setq entry (substring entry 0 (match-beginning 0))))))
1655             ((setq entry (br-find-class-name))
1656              (or (setq path (br-class-path entry))
1657                  (error "(OO-Browser):  No path for this class in current Environment")))
1658             (t (error "(OO-Browser):  No entry for current line in current Environment"))))
1659     (cond ((null path) nil)
1660           ((and prompt standalone) (insert path))
1661           (t (let ((owind (selected-window))
1662                    (buf (buffer-name)))
1663                (br-to-view-window)
1664                (switch-to-buffer (get-buffer-create (concat buf "-Path")))
1665                (setq buffer-read-only nil)
1666                (buffer-disable-undo (current-buffer))
1667                (erase-buffer)
1668                (insert (format "`%s' is defined within\n    \"%s\"" entry path))
1669                (br-major-mode)
1670                (goto-char 1)
1671                (select-window owind)
1672                (message ""))))
1673     path))
1674
1675 (defun br-write-buffer (file)
1676   "Write the narrowed portion of the current browser buffer to a file."
1677   (interactive "FFile to write buffer to: ")
1678   (write-region (point-min) (point-max) file))
1679
1680 ;;; ************************************************************************
1681 ;;; Private functions
1682 ;;; ************************************************************************
1683
1684 (defun br-add-level-hist ()
1685   ;; Even though this next line looks useless, it cures a problem with
1686   ;; window buffer correspondences when the OO-Browser is started, so don't
1687   ;; remove it.
1688   (set-buffer (window-buffer (selected-window)))
1689   (setq *br-level-hist*
1690         (cons (list (selected-window) (buffer-name) (br-wind-line-at-point))
1691               *br-level-hist*)))
1692
1693 (defun br-ancestor-roots (class-list)
1694   "Return sorted list of CLASS-LIST's unique ancestors which do not inherit from any other class.
1695 This list may include elements from CLASS-LIST itself."
1696   (let ((rtn) (parents) func)
1697     (setq func (function
1698                 (lambda (class-list)
1699                   (mapcar
1700                    (function
1701                     (lambda (class)
1702                       (if (not (setq parents (br-get-parents class)))
1703                           (setq rtn (cons class rtn))
1704                         (funcall func parents))))
1705                    class-list))))
1706     (funcall func class-list)
1707     (br-set-of-strings (sort rtn 'string-lessp))))
1708
1709 (defun br-ancestor-trees (class-list &optional depth offset concrete-classes-flag)
1710   "Insert ancestor trees starting with classes from CLASS-LIST.
1711 Ancestor trees are not inverted, i.e. parents appear below children, not
1712 above.  Indent each class in CLASS-LIST by optional DEPTH spaces (default is
1713 0 in order to ensure proper initialization).  Offset each child level by
1714 optional OFFSET spaces from its parent (which must be greater than zero,
1715 default 2).  CONCRETE-CLASSES-FLAG non-nil means omit abstract classes from
1716 the trees."
1717   (or offset (setq offset 2))
1718   (or depth (setq depth 0))
1719   (if (= depth 0) (setq br-tmp-class-set nil))
1720   (let ((prev-expansion-str " ...")
1721         parents expand-subtree)
1722     (mapcar
1723       (function
1724         (lambda (class)
1725           (setq expand-subtree (br-set-cons br-tmp-class-set class)
1726                 parents (if expand-subtree (br-get-parents class)))
1727           (indent-to depth)
1728           (insert class)
1729           (and (not expand-subtree) (br-has-parents-p class)
1730                (insert prev-expansion-str))
1731           (insert "\n")
1732           (if br-ancestor-function
1733               (funcall br-ancestor-function
1734                        class (not expand-subtree) (+ depth offset)))
1735           (if parents
1736               (br-ancestor-trees parents (+ depth offset) offset
1737                                  concrete-classes-flag))))
1738       (if (and concrete-classes-flag
1739                ;; Always include the first level classes
1740                (not (zerop depth)))
1741           (delq nil (mapcar 'br-concrete-class-p class-list))
1742         class-list)))
1743   (if (zerop depth) (setq br-tmp-class-set nil)))
1744
1745 (defun br-ancestor-trees-inverted (class-list &optional depth offset concrete-classes-flag)
1746   "Insert ancestor trees starting with classes from CLASS-LIST.
1747 Ancestor trees are inverted, parents appear above children as in other
1748 browser listing windows.  Indent each class in CLASS-LIST by optional DEPTH
1749 spaces (default is 0 in order to ensure proper initialization).  Offset each
1750 child level by optional OFFSET spaces from its parent (which must be greater
1751 than zero, default 2).  CONCRETE-CLASSES-FLAG non-nil means omit abstract
1752 classes from the trees."
1753   (or offset (setq offset 2))
1754   (or depth (setq depth 0 br-tmp-depth 0))
1755   (if (= depth 0) (setq br-tmp-class-set nil))
1756   (let ((prev-expansion-str " ...")
1757         parents expand-subtree)
1758     (mapcar (function
1759               (lambda (class)
1760                 (setq expand-subtree (br-set-cons br-tmp-class-set class)
1761                       parents (if expand-subtree (br-get-parents class)))
1762                 (if parents
1763                     (progn (setq br-tmp-depth
1764                                  (max (+ depth offset) br-tmp-depth))
1765                            (br-ancestor-trees-inverted
1766                             parents (+ depth offset) offset
1767                             concrete-classes-flag)))
1768                 (indent-to (- br-tmp-depth depth))
1769                 (insert class)
1770                 (and (not expand-subtree) (br-has-children-p class)
1771                      (insert prev-expansion-str))
1772                 (insert "\n")
1773                 (if br-ancestor-function
1774                     (funcall br-ancestor-function
1775                              class (not expand-subtree) (+ depth offset)))
1776                 (if (= depth 0) (setq br-tmp-depth 0))))
1777             (if (and concrete-classes-flag
1778                      ;; Always include the first level classes
1779                      (not (zerop depth)))
1780                 (delq nil (mapcar 'br-concrete-class-p class-list))
1781               class-list)))
1782   (if (zerop depth) (setq br-tmp-class-set nil)))
1783
1784 (defun br-at-class-category-p ()
1785   "Returns t iff point is on a class category listing line."
1786   (if (string-equal br-lang-prefix "objc-")
1787       (save-excursion (beginning-of-line) (looking-at ".*\("))))
1788
1789 (defun br-at-default-class-p ()
1790   "Returns t iff point is within a default class listing entry."
1791   (and (save-excursion
1792          (beginning-of-line)
1793          (looking-at "[ \t]*\\(\\[[^\]]+\\]\\)"))
1794        (>= (point) (match-beginning 1))
1795        (< (point) (match-end 1))))
1796
1797 (defun br-at-feature-p ()
1798   "Returns t iff point is on a feature listing line."
1799   ;; Sometimes as in the case of implementor entries, the listing entry
1800   ;; itself does not begin with a feature indicator character but the
1801   ;; entry from its associated tag does, so use that to test.
1802   (let* ((tag (br-feature-get-tag))
1803          (entry (and tag (br-feature-tag-name tag nil t))))
1804     (and entry (equal (string-match br-feature-entry-regexp entry) 0))))
1805
1806 (defun br-at-protocol-p ()
1807   "Return non-nil if point is within a protocol listing entry line."
1808   (and (br-protocol-support-p)
1809        (save-excursion (beginning-of-line) (looking-at "[ \t]*<"))))
1810
1811 (defun br-browser-buffer-p (&optional buffer)
1812   "Returns t iff optional BUFFER or current buffer is an OO-Browser specific buffer."
1813   (equal 0 (string-match (concat br-buffer-prefix-inher
1814                                  "\\|" br-buffer-prefix-blank
1815                                  "\\|" (regexp-quote br-buffer-prefix-info))
1816                          (buffer-name buffer))))
1817
1818 (defun br-buffer-level ()
1819   "Returns current listing buffer level as a string."
1820   (let* ((name (buffer-name))
1821          (pos (string-match "-[^-0-9]*\\([0-9]+\\)\\'" name)))
1822     (if pos (substring name (match-beginning 1) (match-end 1)))))
1823
1824 (defun br-class-level ()
1825   "Returns current class hierarchy level as an integer.
1826 1 is the top level."
1827   (let ((level-string (br-buffer-level)))
1828     (if level-string (string-to-int level-string))))
1829
1830 (defun br-listing-window-num ()
1831   "Return listing window number, leftmost is 1, non-listing window = 0."
1832   (let ((wind (selected-window))
1833         (ctr 0))
1834     (br-to-view-window)
1835     (while (not (eq wind (selected-window)))
1836       (other-window 1)
1837       (setq ctr (1+ ctr)))
1838     ctr))
1839
1840 (defun br-cleanup ()
1841   "Cleanup and free browser Environment data structures."
1842   (let ((env-file (intern-soft (concat br-lang-prefix "env-file"))))
1843     (if env-file (set env-file nil)))
1844   (setq br-lang-prefix nil
1845         br-sys-paths-htable nil
1846         br-lib-paths-htable nil
1847         br-paths-htable nil
1848         br-sys-parents-htable nil
1849         br-lib-parents-htable nil
1850         br-parents-htable nil
1851         br-children-htable nil
1852         br-lib-prev-search-dirs nil
1853         br-sys-prev-search-dirs nil
1854         ))
1855
1856 (defun br-clear (command-string)
1857   "Re-initialize all browser listing buffer displays.
1858 COMMAND-STRING is a short mnemonic string to attach to the first listing
1859 buffer name to help describe the listing command used."
1860   (let ((n (max 1 (/ (frame-width) br-min-width-window))))
1861     (br-to-view-window)
1862     (other-window 1)
1863     ;; This next expression resets the first level buffer name to be more
1864     ;; descriptive of what is being shown.
1865     (br-next-buffer (concat command-string "1"))
1866     (while (> n 1)
1867       (setq n (1- n))
1868       (br-next-buffer nil br-buffer-prefix-blank))
1869     (br-to-view-window)
1870     (other-window 1)))
1871
1872 (defun br-descendant-trees (class-list &optional indent offset)
1873   "Insert descendant trees starting with classes from CLASS-LIST.
1874 Indent each class in CLASS-LIST by optional INDENT spaces (default is 0 in
1875 order to ensure proper initialization).  Offset each child level by optional
1876 OFFSET spaces from its parent (which must be greater than zero, default 2)."
1877   (or indent (setq indent 0))
1878   (or offset (setq offset 2))
1879   (if (= indent 0) (setq br-tmp-class-set nil))
1880   (let ((prev-expansion-str " ...")
1881         children expand-subtree)
1882     (mapcar (function
1883               (lambda (class)
1884                 (setq expand-subtree (br-set-cons br-tmp-class-set class)
1885                       children (if expand-subtree (br-get-children class)))
1886                 (indent-to indent)
1887                 (insert class)
1888                 (and (not expand-subtree) (br-has-children-p class)
1889                      (insert prev-expansion-str))
1890                 (insert "\n")
1891                 (if children
1892                     (br-descendant-trees children (+ indent offset) offset))))
1893             class-list))
1894   (if (= indent 0) (setq br-tmp-class-set nil)))
1895
1896 (defun br-display-buffer (suffix)
1897   "Displays browser buffer ending in SUFFIX in current window."
1898   (let ((buf (get-buffer (concat br-buffer-prefix suffix))))
1899     (if buf (progn (set-window-buffer (selected-window) buf)))
1900     buf))
1901
1902 (defun br-do-in-view-window (form)
1903   "Evaluate FORM in viewer window and then return to current window."
1904   (interactive)
1905   (let ((wind (selected-window)))
1906     (unwind-protect
1907         (progn (br-to-view-window)
1908                (eval form))
1909       (select-window wind))))
1910
1911 (defun br-edit-ext-start (editor-cmd name file line-num)
1912   "Start an external viewer given by EDITOR-CMD using NAME applied to FILE at LINE-NUM."
1913   (apply 'start-process name name editor-cmd
1914          (if (equal editor-cmd "xterm")
1915              (nconc (list "-title" (if (stringp br-ed2)
1916                                        (concat br-ed2 ": " file)
1917                                      file))
1918                     (delq nil (list br-ed1 br-ed2
1919                                     (if line-num (format "+%s" line-num))
1920                                     br-ed3 br-ed4 br-ed5 br-ed6 br-ed7 br-ed8
1921                                     br-ed9))
1922                     (list file))
1923            (nconc (delq nil (list br-ed1 br-ed2
1924                                   (if line-num (format "+%s" line-num))
1925                                   br-ed3 br-ed4 br-ed5 br-ed6
1926                                   br-ed7 br-ed8 br-ed9))
1927                   (list file)))))
1928
1929 (defun br-edit-externally-p ()
1930   (and br-editor-cmd (or hyperb:window-system
1931                          ;; Support custom Lisp-based edit commands on any
1932                          ;; display type.
1933                          (not (stringp br-editor-cmd)))))
1934
1935 (defun br-view-externally-p ()
1936   (and br-viewer-cmd (or hyperb:window-system
1937                          ;; Support custom Lisp-based view commands
1938                          ;; on any display type.
1939                          (not (stringp br-viewer-cmd)))))
1940
1941 (defun br-edit-externally (path line-num)
1942   "Displays PATH at LINE-NUM in a writable fashion using an external program.
1943 If cannot display PATH, returns nil."
1944   (br-edit-ext br-editor-cmd path line-num))
1945
1946 (defun br-view-externally (path line-num)
1947   "Displays PATH at LINE-NUM in a read-only fashion using an external program and returns t.
1948 If cannot display PATH, returns nil."
1949   (br-view-ext br-viewer-cmd path line-num))
1950
1951 (defun br-funcall-in-view-window (buffer function &optional no-erase)
1952   "Clear out BUFFER and display return value from invocation of FUNCTION in viewer window.
1953 Move point to beginning of buffer and then return to current window.  BUFFER
1954 may be a buffer name.
1955 With optional NO-ERASE, buffer is not erased before function is called."
1956   (interactive)
1957   (let ((wind (selected-window)))
1958     (unwind-protect
1959         (progn (br-to-view-window)
1960                (set-window-buffer (selected-window) (get-buffer-create buffer))
1961                (let (buffer-read-only)
1962                  (if no-erase
1963                      (goto-char (point-min))
1964                    (erase-buffer))
1965                  (funcall function))
1966                (goto-char (point-min)))
1967       (select-window wind))))
1968
1969 (defun br-file-to-viewer (filename)
1970   "Display FILENAME from OO-Browser source directory in browser viewer window.
1971 FILENAME should not contain any path information."
1972   (br-funcall-in-view-window
1973    (concat br-buffer-prefix-info "Help*")
1974    (function (lambda ()
1975                (insert-file-contents (br-pathname filename))
1976                (set-buffer-modified-p nil)))))
1977
1978 (defun br-in-browser ()
1979   "Return selected frame if the OO-Browser is active in it, else return nil."
1980   (cond ((not (eq br-in-browser (selected-frame))) nil)
1981         ((or (one-window-p 'nomini)
1982              (and (fboundp 'window-list)
1983                   (< (length (window-list)) 3)))
1984          (setq br-in-browser nil))
1985         (t br-in-browser)))
1986
1987
1988 (defun br-in-top-buffer-p ()
1989   "Return t if point is in the top class listing buffer, else nil."
1990   (string-equal (br-buffer-level) "1"))
1991
1992 (defun br-in-view-window-p ()
1993   "Is point in a viewer window?
1994 May return t even if not in the OO-Browser."
1995   (and (not (eq (selected-window) (minibuffer-window)))
1996        (br-non-listing-window-p)))
1997
1998 (defun br-init (env-file)
1999   "Initialization common to all OO-Browser invocations.  Uses ENV-FILE argument."
2000   (save-excursion (br-feature-tags-init env-file)))
2001
2002 (defun br-insert-classes (class-list &optional indent)
2003   "Insert CLASS-LIST in current buffer indented INDENT columns."
2004   (mapcar (function
2005             (lambda (class-name)
2006               (and indent (indent-to indent))
2007               (and class-name (insert class-name "\n"))))
2008           class-list))
2009
2010 (defun br-insert-protocol-implementors (protocol-list indent)
2011   (or indent (setq indent 0))
2012   (mapcar
2013    (function
2014     (lambda (item)
2015       (if (eq (aref item 0) ?\<)
2016           ;; abstract class
2017           (progn (if (zerop indent)
2018                      (progn (indent-to indent) (insert item "\n")))
2019                  (br-insert-protocol-implementors (br-get-children item)
2020                                                   (+ indent 2)))
2021         ;; Don't recurse on non-abstract classes since their children
2022         ;; simply inherit conformance to the protocol from them, so they
2023         ;; do not add any information as implementors.
2024         (indent-to indent) (insert item "\n"))))
2025    protocol-list))
2026
2027 (defun br-interrupt (&optional arg)
2028   (if (null arg)
2029       (mapcar
2030        (function
2031         (lambda (buf)
2032           (set-buffer buf)
2033           (if (or (eq major-mode 'br-mode) (br-browser-buffer-p))
2034               (bury-buffer nil))))
2035        (buffer-list))
2036     (setq *br-save-wconfig* nil
2037           *br-prev-wconfig* nil
2038           *br-prev-listing-window* nil)
2039     (mapcar
2040      (function
2041       (lambda (buf)
2042         (set-buffer buf)
2043         (if (or (eq major-mode 'br-mode)
2044                 (br-browser-buffer-p))
2045             (progn (let (buffer-read-only)
2046                      (br-feature-clear-tags)
2047                      (set-buffer-modified-p nil))
2048                    (kill-buffer (current-buffer))))))
2049      (buffer-list))
2050     (br-cleanup))
2051   (setq br-in-browser nil))
2052
2053 (defun br-mode ()
2054   "The major mode used by OO-Browser listing windows.
2055 See the file \"br-help\" for browser usage information.
2056 It provides the following keys: \\{br-mode-map}"
2057   (interactive)
2058   (use-local-map br-mode-map)
2059   (setq major-mode 'br-mode)
2060   (setq mode-name "OO-Browse")
2061   (set-syntax-table text-mode-syntax-table)
2062   (setq local-abbrev-table text-mode-abbrev-table)
2063   (setq case-fold-search t)
2064   (setq buffer-read-only t)
2065   (if (fboundp 'popup-mode-menu)
2066       (setq mode-popup-menu id-popup-br-menu))
2067   (run-hooks 'br-class-list-hook)
2068   (run-hooks 'br-mode-hook))
2069
2070 (defun br-next-buffer (&optional special alt-prefix)
2071   "Returns next sequential browser buffer or special one if optional SPECIAL is non-nil.
2072 Non-nil ALT-PREFIX is used as prefix in buffer name."
2073   (let* ((suffix (concat special
2074                          (if (and (stringp special)
2075                                   (string-match "[0-9]\\'" special))
2076                              nil
2077                            (int-to-string (1+ (or (br-class-level) 0))))))
2078          (buf (get-buffer-create
2079                (concat (or alt-prefix br-buffer-prefix)
2080                        (if (integerp suffix)
2081                            (int-to-string suffix)
2082                          suffix)))))
2083     (if buf (progn
2084               (or special (br-next-listing-window))
2085               (set-window-buffer (selected-window) buf)
2086               (let (buffer-read-only)
2087                 (kill-all-local-variables)
2088                 (buffer-disable-undo (current-buffer))
2089                 ;; Clear out any feature tags that may have been associated
2090                 ;; with this buffer, so we don't mistakenly reference them.
2091                 (br-feature-clear-tags)
2092                 (erase-buffer))
2093               (make-local-variable 'frame-title-format)
2094               (setq frame-title-format
2095                     (list "OO-Browser-" br-version "@" (system-name) ":  "
2096                           br-env-name " - " br-env-file))
2097               (br-mode)
2098               (br-set-mode-line)
2099               (set-buffer-modified-p nil)))
2100     buf))
2101
2102 (defun br-next-listing-window (&optional prev)
2103   "Move to next browser listing window (non-viewer window).
2104 Optional PREV means to previous window."
2105   ;; The `br-non-listing-window-p' call below calls `br-in-browser' which if
2106   ;; called from `br-window-setup' when initializing browser windows can
2107   ;; set the variable, br-in-browser, to nil since it doesn't recognize the
2108   ;; window configuration.  Prevent this by making the variable local for this
2109   ;; function.
2110   (let ((owind (selected-window))
2111         (br-in-browser br-in-browser))
2112     (while (progn (other-window (if prev -1 1))
2113                   (if (br-non-listing-window-p)
2114                       (not (eq (selected-window) owind))))
2115       (setq br-in-browser (selected-frame)))))
2116
2117 (defun br-pathname (filename)
2118   "Return full pathname for FILENAME in browser Elisp directory."
2119   (if br-directory
2120       (expand-file-name filename br-directory)
2121     (error "The `br-directory' variable must be set to a string value.")))
2122
2123 (defun br-resize (min-width)
2124   "Resize browser listing windows to have MIN-WIDTH."
2125   (interactive)
2126   (let* ((window-min-width 3)
2127          (oldn (1- (length (br-window-list))))
2128          (n (max 1 (/ (frame-width) min-width)))
2129          (numw n)
2130          (diff (- numw oldn))
2131          (width (/ (frame-width) numw))
2132          (obuf (current-buffer)))
2133     (br-to-first-list-window)
2134     (cond ((= diff 0)
2135            (br-resize-windows numw width))
2136           ((> diff 0)
2137            (setq n oldn)
2138            (while (> n 1)
2139              (setq n (1- n))
2140              (shrink-window-horizontally (max 0 (- (window-width)
2141                                                    min-width)))
2142              (br-next-listing-window))
2143            (setq n diff)
2144            (while (> n 0)
2145              (setq n (1- n))
2146              (split-window-horizontally (max window-min-width
2147                                              (- (window-width)
2148                                                 min-width))))
2149            (setq n oldn)
2150            (while (< n numw)
2151              (setq n (1+ n))
2152              (br-next-listing-window)
2153              (br-next-buffer n br-buffer-prefix-blank))
2154            (br-to-first-list-window)
2155            (br-resize-windows numw width)
2156            )
2157           (t  ;; (< diff 0)
2158            (while (> n 0)
2159              (setq n (1- n))
2160              (br-next-listing-window))
2161            (setq n (- diff))
2162            (while (> n 0)
2163              (setq n (1- n))
2164              (delete-window))
2165            (br-to-first-list-window)
2166            (br-resize-windows numw width)
2167            ))
2168     (setq br-min-width-window min-width)
2169     (let ((owind (get-buffer-window obuf)))
2170       (if owind
2171           (select-window owind)
2172         (br-to-view-window)
2173         (br-next-listing-window)))))
2174
2175 (defun br-resize-narrow ()
2176   "Narrow listing windows by 10 characters."
2177   (interactive)
2178   (if (<= window-min-width (- br-min-width-window 10))
2179       (br-resize (max window-min-width (- br-min-width-window 10)))
2180     (beep)))
2181
2182 (defun br-resize-widen ()
2183   "Widen listing windows by 10 characters."
2184   (interactive)
2185   (if (and (>= (frame-width) (+ br-min-width-window 10))
2186            (> (length (br-window-list)) 2))
2187       (br-resize (min (frame-width) (+ br-min-width-window 10)))
2188     (beep)))
2189
2190 (defun br-resize-windows (n width)
2191   (while (> n 1)
2192     (setq n (1- n))
2193     (shrink-window-horizontally (- (window-width) width))
2194     (br-next-listing-window)))
2195
2196 (defun br-set-mode-line ()
2197   "Set mode line string."
2198   (setq mode-line-format (list "  %17b --" '(-3 . "%p") "-%-")
2199         mode-line-buffer-identification (list (buffer-name)))
2200   (set-buffer-modified-p t))
2201
2202 (defun br-setup-next-window (command-string)
2203   "Setup to display OO-Browser command output in the next listing window.
2204 COMMAND-STRING is usually a one character mnemonic string for the command
2205 generating the output for the window.  It is added to the buffer name
2206 preceding a level number to aid the user in navigation."
2207   (let ((next-level
2208          (if (and (stringp command-string)
2209                   (string-match "[0-9]\\'" command-string))
2210              nil
2211            (int-to-string (1+ (or (br-class-level) 0))))))
2212     (br-add-level-hist)
2213     (br-next-listing-window)
2214     (br-next-buffer (concat command-string next-level))))
2215
2216 (defun br-show-classes (func top-only-flag &optional uniq command-string)
2217   "Display a list of classes generated by calling FUNC.
2218 TOP-ONLY-FLAG means only top-level classes (those that don't inherit from any
2219 other non-abstract class) are listed.  Optional UNIQ means sort and eliminate
2220 duplicates.
2221 COMMAND-STRING is a short mnemonic string to attach to the listing buffer name
2222 to help describe the listing command used."
2223   (message "Ordering classes...")
2224   (let ((classes (funcall func)))
2225     (setq classes (br-class-list-filter classes top-only-flag))
2226     (br-clear command-string)
2227     (let (buffer-read-only)
2228       (erase-buffer)
2229       (br-insert-classes classes)
2230       (if uniq
2231           (progn
2232             (if (stringp br-sort-options)
2233                 (call-process-region (point-min) (point-max) "sort" t t nil
2234                                      br-sort-options)
2235               (call-process-region (point-min) (point-max) "sort" t t nil))
2236             (if (or (and (stringp br-sort-options)
2237                          (string-match "u" br-sort-options))
2238                     ;; Then sort made the list of elements unique, so
2239                     ;; do nothing, or if can't find uniq program, do
2240                     ;; nothing.
2241                     (not (locate-file "uniq" exec-path ":.exe")))
2242                 nil
2243               (call-process-region (point-min) (point-max) "uniq" t t))))))
2244   (goto-char (point-min))
2245   (message "Ordering classes...Done"))
2246
2247 (defun br-this-level-classes (&optional keep-indent)
2248   "Return the class entries from the current browser listing.
2249 Optional KEEP-INDENT non-nil means keep indentation preceding class name."
2250   (let ((classes)
2251         (feature-regexp (format "^[ \t]*%s " br-feature-type-regexp)))
2252     (save-excursion
2253       (goto-char (point-min))
2254       (while (and (not (looking-at "^[ \t]*$"))
2255                   (if (and
2256                        ;; Treat protocol/interface and category entries as classes.
2257                        (not (looking-at "^[ \t]*[<\(]"))
2258                        ;; Ignore feature entries
2259                        (looking-at feature-regexp))
2260                       t ;; skip this entry
2261                     ;; assume is a class
2262                     (setq classes (cons (br-find-class-name keep-indent)
2263                                         classes)))
2264                   (= (forward-line 1) 0))))
2265     (nreverse (delq nil classes))))
2266
2267 (defun br-this-level-entries ()
2268   "Return list of all entries in the current listing."
2269   (let ((entries)
2270         (feature-regexp (format "^[ \t]*%s " br-feature-type-regexp)))
2271     (save-excursion
2272       (goto-char (point-min))
2273       (while (and (not (looking-at "^[ \t]*$"))
2274                   (if (looking-at feature-regexp)
2275                       ;; a feature
2276                       (setq entries (cons (br-find-feature-entry) entries))
2277                     ;; assume is a class
2278                     (setq entries (cons (br-find-class-name) entries)))
2279                   (= (forward-line 1) 0))))
2280     (nreverse (delq nil entries))))
2281
2282 (defun br-this-level-features ()
2283   "Return list of features in the current listing."
2284   (let ((feature-regexp (concat "[ \t]*" br-feature-entry-regexp))
2285         (feature-list))
2286     (save-excursion
2287       (goto-char (point-min))
2288       (while (progn (if (looking-at feature-regexp)
2289                         (setq feature-list
2290                               (cons (br-find-feature-entry) feature-list)))
2291                     (= (forward-line 1) 0))))
2292     (nreverse (delq nil feature-list))))
2293
2294 (defun br-to-first-list-window ()
2295   (br-to-view-window)
2296   (br-next-listing-window))
2297
2298 (defun br-to-tree ()
2299   "If point is within ellipses (...), move to the inheritance expansion for the current class."
2300   (if (save-excursion
2301         (skip-chars-backward ".")
2302         (looking-at "\\.\\.\\."))
2303       (progn (beginning-of-line)
2304              (let ((class-expr (concat "^[ \t]*"
2305                                        (br-find-class-name)
2306                                        "$")))
2307                (if (re-search-backward class-expr nil t)
2308                    (progn (skip-chars-forward " \t")
2309                           (recenter '(4))
2310                           t))))))
2311
2312 (defun br-to-view-window ()
2313   "Move to viewer window."
2314   (if (br-in-view-window-p)
2315       nil
2316     (setq *br-prev-listing-window* (selected-window))
2317     (while (and (not (br-in-view-window-p))
2318                 (progn (other-window 1)
2319                        (not (eq (selected-window)
2320                                 *br-prev-listing-window*)))))))
2321
2322 (defun br-window-setup ()
2323   (and (fboundp 'modify-frame-parameters)
2324        (cdr (assq 'unsplittable (frame-parameters)))
2325        (modify-frame-parameters (selected-frame) '((unsplittable))))
2326   (delete-other-windows)
2327   ;; Set top of frame line in case it is not 0.
2328   (or (fboundp 'window-highest-p)
2329       (setq br-top-of-frame (nth 1 (window-edges))))
2330   (split-window-vertically nil)
2331   (let* ((n (max 1 (/ (frame-width) br-min-width-window)))
2332          (width (/ (frame-width) n))
2333          (start-win))
2334     ;; `A' means all classes will be listed, 1 = first buffer
2335     (br-next-buffer "A1")
2336     (while (> n 1)
2337       (setq n (1- n))
2338       (if (<= (window-width (selected-window)) width)
2339           (progn (setq start-win (selected-window))
2340                  (while (and (progn (other-window 1)
2341                                     (if (fboundp 'window-highest-p)
2342                                         (window-highest-p (selected-window))
2343                                       (= (nth 1 (window-edges))
2344                                          br-top-of-frame)))
2345                              (not (eq (selected-window) start-win))
2346                              (<= (window-width (selected-window)) width)))))
2347       (split-window-horizontally width)
2348       (br-next-buffer nil br-buffer-prefix-blank)))
2349   ;;
2350   ;; Leave point in the first window
2351   (br-to-view-window)
2352   (other-window 1))
2353
2354 (defun br-view-ext-start (viewer-cmd name file line-num)
2355   "Start an external viewer given by VIEWER-CMD using NAME applied to FILE at LINE-NUM."
2356   (apply 'start-process name name viewer-cmd
2357          (if (equal viewer-cmd "xterm")
2358              (nconc (list "-title" (if (stringp br-vw2)
2359                                        (concat br-vw2 ": " file)
2360                                      file))
2361                     (delq nil (list br-vw1 br-vw2
2362                                     (if line-num (format "+%s" line-num))
2363                                     br-vw3 br-vw4 br-vw5 br-vw6 br-vw7 br-vw8
2364                                     br-vw9))
2365                     (list file))
2366            (nconc (if line-num (list (format "+%s" line-num)))
2367                   (delq nil (list br-vw1 br-vw2 br-vw3 br-vw4 br-vw5 br-vw6
2368                                   br-vw7 br-vw8 br-vw9))
2369                   (list file)))))
2370
2371 ;;; ************************************************************************
2372 ;;; Private variables
2373 ;;; ************************************************************************
2374
2375 (defvar br-ancestor-function nil
2376   "If non-nil, a function of 3 arguments called after each ancestor class is inserted into an ancestry listing.
2377 First argument is the class just inserted, second argument is a flag
2378 indicating whether class has previously been displayed within the listing and
2379 third argument is the number of spaces to indent each feature entry for this
2380 class.")
2381
2382 (defvar br-top-of-frame 0
2383   "Frame-relative line number at which the OO-Browser frame's uppermost windows start.")
2384
2385 (defvar br-ed-num 0)
2386 (defvar br-ed-name "extEd")
2387 (defvar br-vw-num 0)
2388 (defvar br-vw-name "extVw")
2389
2390 (defvar br-in-browser nil
2391   "Equal to the frame displaying the OO-Browser when in use, else nil.")
2392
2393 (defvar br-lib-search-dirs nil
2394   "List of directories below which OO source files and other library
2395 directories are found.  A library is a stable group of OO classes.  Do not
2396 set this variable directly.  Each OO language library which invokes
2397 `br-browse' should set it.")
2398
2399 (defvar br-sys-search-dirs nil
2400   "List of directories below which OO source files and other system
2401 directories are found.  A system is a group of OO classes that are likely to
2402 change.  Do not set this variable directly.  Each OO language library which
2403 invokes `br-browse' should set it.")
2404
2405 (defvar *br-level-hist* nil
2406   "Internal history of visited listing windows and buffers.")
2407
2408 (defvar *br-prev-listing-window* nil
2409   "Saves listing window used prior to viewer window entry.
2410 Allows return to previous listing window when done with the viewer.")
2411
2412 (defvar *br-prev-wconfig* nil
2413   "Saves window configuration prior to browser entry.")
2414
2415 (defvar *br-save-wconfig* nil
2416   "Saves window configuration between invocations of the browser.")
2417
2418 (defconst br-buffer-prefix-inher "OO-Browse-")
2419 (defconst br-buffer-prefix-blank "Blank-")
2420 (defconst br-buffer-prefix-info "*OO-Browser ")
2421 (defvar br-buffer-prefix br-buffer-prefix-inher
2422   "Browser buffer name prefix.")
2423
2424
2425 (defvar br-mode-map nil
2426   "Keymap containing OO-Browser commands.")
2427 (if br-mode-map
2428     nil
2429   (setq br-mode-map (make-keymap))
2430   (suppress-keymap br-mode-map)
2431   (define-key br-mode-map "@"        'br-at)
2432   (define-key br-mode-map "="        'br-attributes)
2433   (define-key br-mode-map "\<"       'br-viewer-beginning-of-buffer)
2434   (define-key br-mode-map "\>"       'br-viewer-end-of-buffer)
2435   (define-key br-mode-map ","        'br-viewer-scroll-down-by-line)
2436   (define-key br-mode-map "."        'br-viewer-scroll-up-by-line)
2437   (define-key br-mode-map "1"        'br-view-full-frame)
2438 ;  (define-key br-mode-map "\C-c^"    'br-add-class-file)
2439   (define-key br-mode-map "a"        'br-ancestors)
2440   (define-key br-mode-map "A"        'br-show-all-classes)
2441   (define-key br-mode-map "\M-a"     'br-name-add)
2442   (define-key br-mode-map "b"        'br-buffer-menu)
2443   (define-key br-mode-map "\C-c\C-b" 'br-report-bug)
2444   (define-key br-mode-map "c"        'br-children)
2445   (define-key br-mode-map "C"        'br-categories)
2446   (define-key br-mode-map "\M-c"     'br-class-stats)
2447   (define-key br-mode-map "\C-c\C-c" 'br-env-browse)
2448   (define-key br-mode-map "d"        'br-descendants)
2449   (define-key br-mode-map "\C-c\C-d" 'br-delete)
2450   ;; {M-d} is used down below for `br-tree'
2451   (define-key br-mode-map "e"        'br-edit-entry)
2452   (define-key br-mode-map "\M-e"     'br-env-stats)
2453   (define-key br-mode-map "\C-c\C-e" 'br-env-rebuild)
2454   (define-key br-mode-map "f"        'br-features)
2455   (define-key br-mode-map "F"        'br-feature-signature)
2456   ;; {M-f} is used down below for `br-tree-features-toggle'
2457   ;; {M-g} is used down below for `br-tree-graph'
2458   (define-key br-mode-map "?"        'br-help)
2459   (define-key br-mode-map "h"        'br-help)
2460   (define-key br-mode-map "H"        'br-help-ms) ;; mouse help
2461   (define-key br-mode-map "i"        'br-entry-info)
2462   (define-key br-mode-map "I"        'br-implementors)
2463   (define-key br-mode-map "j"        'br-feature-view-declaration)
2464   (define-key br-mode-map "J"        'br-feature-edit-declaration)
2465   (define-key br-mode-map "\C-c\C-k" 'br-kill)
2466   ;; {M-k} is used down below for `br-tree-kill'
2467   (define-key br-mode-map "l"        'br-lib-top-classes)
2468   (define-key br-mode-map "L"        'br-lib-rebuild)
2469   (define-key br-mode-map "\M-l"     'br-names-display)
2470   (define-key br-mode-map "\C-c\C-l" 'br-env-load)
2471   (define-key br-mode-map "m"        'br-match)
2472   (define-key br-mode-map "M"        'br-match-entries)
2473   (define-key br-mode-map "\M-m"     'br-name-remove)
2474   ;; "\C-c\C-m" is reserved for future use.
2475   (define-key br-mode-map "\M-n"     'br-name-change)
2476   (define-key br-mode-map "\C-n"     'br-next-entry)
2477   (define-key br-mode-map "o"        'br-order)
2478   (define-key br-mode-map "p"        'br-parents)
2479   (define-key br-mode-map "P"        'br-protocols)
2480   (define-key br-mode-map "\C-p"     'br-prev-entry)
2481   (define-key br-mode-map "q"        'br-quit)
2482   (define-key br-mode-map "r"        'br-routines)
2483   (define-key br-mode-map "\M-r"     'br-name-replace)
2484   (define-key br-mode-map "\C-c\C-r" 'br-refresh)
2485   (define-key br-mode-map "s"        'br-sys-top-classes)
2486   (define-key br-mode-map "S"        'br-sys-rebuild)
2487   (define-key br-mode-map "\C-c\C-s" 'br-env-save)
2488   (define-key br-mode-map "t"        'br-show-top-classes)
2489   (define-key br-mode-map "T"        'br-show-top-classes)
2490   (define-key br-mode-map "u"        'br-unique)
2491   (define-key br-mode-map "v"        'br-view-entry)
2492   (define-key br-mode-map "V"        'br-view-friend)
2493   (define-key br-mode-map "\C-c\C-v" 'br-to-from-viewer)
2494   (define-key br-mode-map "\C-c\C-w" 'br-write-buffer)
2495   (define-key br-mode-map "w"        'br-where)
2496   (define-key br-mode-map "x"        'br-exit-level)
2497   (define-key br-mode-map "\C-x-"    'br-resize-narrow)
2498   (define-key br-mode-map "\C-x+"    'br-resize-widen)
2499   (define-key br-mode-map "#"        'br-count)
2500   (define-key br-mode-map "\C-c#"    'br-version)
2501   (define-key br-mode-map " "        'br-viewer-scroll-up)
2502   (define-key br-mode-map "\177"     'br-viewer-scroll-down)
2503   (if (string-match "XEmacs" emacs-version)
2504       (define-key br-mode-map '[backspace] 'br-viewer-scroll-down))
2505   ;;
2506   ;; Mouse keys
2507   (cond ((fboundp 'popup-mode-menu) nil)
2508         (hyperb:xemacs-p
2509          (define-key br-mode-map 'button3 'br-popup-menu)
2510          (define-key br-mode-map 'button3up nil))
2511         (t ;; hyperb:emacs19-p
2512          (define-key br-mode-map [down-mouse-3] 'br-popup-menu)
2513          (define-key br-mode-map [mouse-3] nil)))
2514   ;;
2515   ;; Define graphical browser keys if a window system is available.
2516   (if hyperb:window-system
2517       (progn (require 'br-tree)
2518              (define-key br-mode-map "\M-d" 'br-tree)
2519              (define-key br-mode-map "\M-f" 'br-tree-features-toggle)
2520              (define-key br-mode-map "\M-g" 'br-tree-graph)
2521              (define-key br-mode-map "\M-k" 'br-tree-kill))))
2522
2523 (defvar br-tmp-class-set nil
2524   "Set of classes created for temporary use by br-*-trees functions.")
2525 (defvar br-tmp-depth 0
2526   "Temporary variable indicating inheritance depth of class in `br-ancestor-trees-inverted'.")
2527
2528 (provide 'br)