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

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         br-env.el
   4 ;; SUMMARY:      OO-Browser Environment support functions.
   5 ;; USAGE:        GNU Emacs Lisp Library
   6 ;; KEYWORDS:     oop, tools
   7 ;;
   8 ;; AUTHOR:       Bob Weiner
   9 ;; ORG:          BeOpen.com
  10 ;;
  11 ;; ORIG-DATE:     8-Jun-90
  12 ;; LAST-MOD:     18-Apr-01 at 16:26:50 by Bob Weiner
  13 ;;
  14 ;; Copyright (C) 1989-1995, 1997, 1998 BeOpen.com
  15 ;; See the file BR-COPY for license information.
  16 ;;
  17 ;; This file is part of the OO-Browser.
  18
  19 ;;; ************************************************************************
  20 ;;; Other required Elisp libraries
  21 ;;; ************************************************************************
  22
  23 (require 'br-start)
  24 (require 'hasht)
  25 (require 'hypb)
  26 (require 'br-name)
  27
  28 ;;; ************************************************************************
  29 ;;; Public functions
  30 ;;; ************************************************************************
  31
  32 (if (fboundp 'file-relative-name)
  33     nil
  34   ;; For V18 Emacs
  35   (defun file-relative-name (filename &optional directory)
  36     "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
  37     (setq filename (expand-file-name filename)
  38           directory (file-name-as-directory (if directory
  39                                                 (expand-file-name directory)
  40                                               default-directory)))
  41     (while directory
  42       (let ((up (file-name-directory (directory-file-name directory))))
  43         (cond ((and (string-equal directory up)
  44                     (file-name-absolute-p directory))
  45                ;; "/"
  46                (setq directory nil))
  47               ((string-match (concat "\\`" (regexp-quote directory))
  48                              filename)
  49                (setq filename (substring filename (match-end 0)))
  50                (setq directory nil))
  51               (t
  52                ;; go up one level
  53                (setq directory up)))))
  54     filename))
  55
  56 ;; NOTE: First argument to this function must remain `env-file'
  57 ;; because of the way it is called from "hpath.el".
  58 ;;;###autoload
  59 (defun br-env-browse (env-file &optional env-name)
  60   "Invoke the OO-Browser on an existing or to be created Environment ENV-FILE or ENV-NAME."
  61   (interactive
  62    (progn (br-names-initialize)
  63           (setq env-name
  64                 (br-name-read "Load/Create OO-Browser Env named: " nil))
  65           (setq env-file (or (br-name-get-env-file env-name)
  66                              (br-env-read-file-name
  67                               (if (or (eq env-name t) (equal env-name ""))
  68                                   "Load/Create unnamed OO-Browser Env file: "
  69                                 (format "Associate `%s' with file: " env-name))
  70                               default-directory
  71                               (expand-file-name br-env-default-file))))
  72           (if (eq env-name t)
  73               ;; br-env-name must be set here to prevent the name of the
  74               ;; previously loaded Env from remaining after the new unnamed
  75               ;; Env is loaded.
  76               (setq br-env-name t))
  77           (list env-file env-name)))
  78
  79   (let ((file-name-cons (br-env-validate-arg-strings
  80                          "br-env-browse" env-file env-name)))
  81     (setq env-file (car file-name-cons)
  82           env-name (cdr file-name-cons)))
  83   ;; Save env-name permanently so is not lost if an error is signalled
  84   ;; anywhere below.
  85   (or (br-name-get-env-file env-name)
  86       (br-name-add env-name env-file))
  87   (cond ((and (file-exists-p env-file)
  88               (not (file-readable-p env-file)))
  89          (error "(br-env-browse): Env file `%s' is unreadable." env-file))
  90         ((not (file-exists-p env-file))
  91          ;; Specify a new Environment
  92          (funcall (intern-soft (concat (br-env-select-lang) "browse"))
  93                   env-file))
  94         (t;; Existing Environment
  95          (let ((lang-string (br-env-read-language-prefix env-file)))
  96            (if lang-string
  97                (funcall (intern-soft (concat lang-string "browse"))
  98                         env-file)
  99              (error "(br-env-browse): Invalid env file: `%s'" env-file))))))
 100
 101 (defun br-env-build (&optional env-file env-name background-flag no-load)
 102   "Build and load Environment from spec given by optional ENV-FILE, ENV-NAME or `br-env-file'.
 103
 104 If optional 2nd argument BACKGROUND-FLAG is t, build the Environment using a
 105 background process.  If it is nil, build in foreground.  If it is the symbol,
 106 debug, build in the background and show a debug backtrace if any error occurs
 107 \(under InfoDock and XEmacs only).  Any other value prompts for whether to
 108 build in the background if the `make' program is found within `exec-path'.
 109
 110 If optional 3rd argument NO-LOAD is non-nil, the Environment is not loaded by
 111 this function (since `br-env-load' might call this itself)."
 112   (interactive
 113    (progn (br-names-initialize)
 114           (setq env-name
 115                 (br-name-read "Build OO-Browser Env named: " nil))
 116           (setq env-file (or (br-name-get-env-file env-name)
 117                              (br-env-read-file-name
 118                               (if (or (eq env-name t) (equal env-name ""))
 119                                   "Build unnamed OO-Browser Env file: "
 120                                 (format "Associate `%s' with file: " env-name))
 121                               default-directory
 122                               (expand-file-name br-env-default-file)
 123                               t)))
 124           (list env-file env-name 'prompt nil)))
 125   (cond ((or (null background-flag) (eq background-flag t)
 126              (eq background-flag 'debug))
 127          (if (not (locate-file "make" exec-path ":.exe"))
 128              (setq background-flag nil)))
 129         (noninteractive
 130          (setq background-flag nil))
 131         (t (setq background-flag
 132                  (if (locate-file "make" exec-path ":.exe")
 133                      (y-or-n-p "Build Environment in the background? ")))))
 134
 135   (let ((file-name-cons (br-env-validate-arg-strings
 136                          "br-env-build" env-file env-name)))
 137     (setq env-file (car file-name-cons)
 138           env-name (cdr file-name-cons)))
 139   (if (or (not (stringp env-file)) (equal env-file ""))
 140       (setq env-file br-env-file))
 141   (setq env-file (expand-file-name env-file))
 142   (or (not (file-exists-p env-file)) (file-readable-p env-file)
 143       (error "Non-readable Environment file, \"%s\"" env-file))
 144   (or (file-writable-p env-file)
 145       (error "Non-writable Environment file, \"%s\"" env-file))
 146
 147   (if background-flag
 148       (progn (setenv "OO_BROWSER_ENV" env-file)
 149              (setenv "OO_BROWSER_ENV_NAME"
 150                      (cond ((eq env-name t) "t")
 151                            ((null env-name) "nil")
 152                            (t env-name)))
 153              (setenv "EMACSLOADPATH" (mapconcat 'identity load-path
 154                                                 (if hyperb:microcruft-os-p
 155                                                     ";" ":")))
 156              (let ((default-directory br-directory))
 157                (compile
 158                 (format "make -f Make-Env%s %s"
 159                         (if (and (boundp 'invocation-directory)
 160                                  (boundp 'invocation-name)
 161                                  (stringp invocation-directory)
 162                                  (stringp invocation-name)
 163                                  (file-directory-p invocation-directory)
 164                                  (file-name-absolute-p invocation-directory))
 165                             (concat " EMACS="
 166                                     (expand-file-name
 167                                      invocation-name invocation-directory))
 168                           "")
 169                         (if (eq background-flag 'debug)
 170                             "oo-browser-env-debug" "oo-browser-env")))))
 171     (or no-load (br-env-load env-file env-name nil t))
 172     (setq br-env-start-build-time (current-time-string))
 173     ;; Detach unneeded data so can be garbage collected.
 174     (br-env-create-alists)
 175     (br-env-create-htables)
 176     (if (and (boundp 'br-feature-tags-file) (stringp br-feature-tags-file))
 177         (progn
 178           (if (not (file-writable-p br-feature-tags-file))
 179               (error
 180                "(br-env-build): %s is not writable" br-feature-tags-file))
 181           (set-buffer (find-file-noselect br-feature-tags-file))
 182           (setq buffer-read-only nil)
 183           (erase-buffer)
 184           (set-buffer-modified-p nil)))
 185     (br-build-sys-htable)
 186     (br-build-lib-htable)
 187     (br-feature-build-htables)
 188     (setq br-env-spec nil
 189           br-env-end-build-time (current-time-string))
 190     (br-env-save)
 191     ;; Detach unneeded data so can be garbage collected.
 192     (br-env-create-alists)
 193     (if (or noninteractive no-load)
 194         nil
 195       (br-env-load env-file env-name nil t))))
 196
 197 (defun br-env-rebuild (debug-flag)
 198   "Rescan System and Library sources associated with the current Environment.
 199 When given a prefix arg, DEBUG-FLAG, it will output a debugging backtrace if
 200 any error occurs during scanning (InfoDock and XEmacs only)."
 201   (interactive "P")
 202   (cond ((null br-env-file)
 203          (error "(br-env-rebuild): Load an Environment before calling this."))
 204         ((interactive-p)
 205          (if debug-flag
 206              (if (y-or-n-p (format "Debug build of `%s'? "
 207                                    (or (and (stringp br-env-name) br-env-name)
 208                                        br-env-file)))
 209                  (br-env-build br-env-file br-env-name 'debug))
 210            (if (y-or-n-p (format "Rebuild `%s'? "
 211                                  (or (and (stringp br-env-name) br-env-name)
 212                                      br-env-file)))
 213                (br-env-build br-env-file br-env-name 'prompt))))
 214         (t (error "(br-env-rebuild): This must be called interactively."))))
 215
 216 (defun br-env-create (&optional env-file lang-prefix)
 217   "Create and save the specification of a new OO-Browser Environment.
 218 Interactively prompt for the Environment file name or use optional ENV-FILE.
 219 Interactively prompt for the Environment language to use or use optional
 220 LANG-PREFIX as the language indicator.
 221
 222 If called interactively and presently in the OO-Browser and the current
 223 Environment is the one that has been re-specified, automatically rebuild it.
 224 Otherwise, prompt for whether to build the Environment.
 225
 226 Return the name of the Environment specification file that was created."
 227   (if (stringp env-file)
 228       (read-string
 229        "Hit RET to specify the code directories for the Environment. ")
 230     (setq env-file (or (br-name-get-env-file br-env-name)
 231                        (br-env-read-file-name
 232                         (if (or (eq br-env-name t) (equal br-env-name ""))
 233                             "Create unnamed OO-Browser Env file: "
 234                           (format "Associate `%s' with file: " br-env-name))
 235                         default-directory
 236                         (expand-file-name br-env-default-file)))))
 237   ;; Between the time when a new Envir name was specified by the user and the
 238   ;; call to this function, a cached set of Envir variables may have been
 239   ;; reloaded and this may have reset `br-env-name' to t even though a name
 240   ;; was given.  Ensure that any name available is reset here.
 241   (if (eq br-env-name t)
 242       (setq br-env-name (or (br-name-get env-file) t)))
 243   (let ((file-name-cons (br-env-validate-arg-strings
 244                          "br-env-create" env-file br-env-name)))
 245     (setq env-file (car file-name-cons)))
 246
 247   ;; Display Env spec if a previous one existed.
 248   (and (equal env-file br-env-file) (file-readable-p env-file) (br-env-stats))
 249   (let ((prompt "Top-level system-specific code dir #%d (RET to end): ")
 250         (br-env-spec t)
 251         br-sys-search-dirs br-lib-search-dirs
 252         br-lang-prefix
 253         br-children-htable
 254         br-sys-paths-htable
 255         br-sys-parents-htable
 256         br-lib-paths-htable
 257         br-lib-parents-htable
 258         br-paths-htable
 259         br-parents-htable)
 260     (br-env-create-htables)
 261     (setq br-lang-prefix (or lang-prefix (br-env-select-lang))
 262           br-sys-search-dirs (br-env-get-dirs prompt)
 263           ;; The leading whitespace is to give a visual indication that
 264           ;; the time of directory being prompted for has changed from System
 265           ;; to Library.
 266           prompt "  Top-level reusable code library dir #%d (RET to end): "
 267           br-lib-search-dirs (br-env-get-dirs prompt))
 268     ;; Now since user has not aborted, set real variables
 269     (setq br-env-spec t)
 270     (br-env-save env-file)
 271     ;; If called interactively and re-specifying current Env, then also
 272     ;; rebuild it.
 273     (if (interactive-p)
 274         (if (equal env-file br-env-file)
 275             (if (br-in-browser)
 276                 ;; auto-build
 277                 (br-env-build
 278                  br-env-file br-env-name
 279                  (y-or-n-p
 280                   "The Environment will now be built; build it in the background? "))
 281               (call-interactively 'br-env-build))))
 282     env-file))
 283
 284 ;;;###autoload
 285 (defun br-env-load (&optional env-file env-name prompt no-build)
 286   "Load an OO-Browser Environment or specification from optional ENV-FILE, ENV-NAME or `br-env-file'.
 287 Non-nil PROMPT means prompt user before building the Environment.
 288 Non-nil NO-BUILD means skip the build of the Environment entirely.
 289 Return t if the load is successful, else nil."
 290   (interactive
 291    (progn (br-names-initialize)
 292           (setq env-name
 293                 (br-name-read "Load OO-Browser Env named: " t))
 294           (setq env-file (or (br-name-get-env-file env-name)
 295                              (br-env-read-file-name
 296                               (if (or (eq env-name t) (equal env-name ""))
 297                                   "Load Environment from file: "
 298                                 (format "Load `%s' from file: " env-name))
 299                               default-directory
 300                               (expand-file-name br-env-default-file)
 301                               t)))
 302           (list env-file env-name nil nil)))
 303   (let ((file-name-cons (br-env-validate-arg-strings
 304                          "br-env-load" env-file env-name)))
 305     (setq env-file (car file-name-cons)
 306           env-name (cdr file-name-cons)))
 307   (setq env-file (or (and (not (equal env-file "")) env-file)
 308                      (br-env-default-file))
 309         env-file (expand-file-name env-file))
 310   (let ((buf (get-file-buffer env-file)))
 311     (and buf (kill-buffer buf)))
 312   (let ((br-loaded))
 313     (if (file-readable-p env-file)
 314         (unwind-protect
 315             (progn
 316               (message "Loading Environment...")
 317               (sit-for 1)
 318               ;; Ensure spec, version, time and feature values are nil for
 319               ;; old Environment files that do not contain a setting for
 320               ;; these variables.
 321               (setq br-env-spec nil br-env-version nil
 322                     br-env-start-build-time nil
 323                     br-env-end-build-time nil
 324                     br-features-alist nil
 325                     br-feature-paths-alist nil)
 326
 327               ;; Ensure that OO-Browser support libraries for the current
 328               ;; language are loaded, since this function may be called
 329               ;; without invoking the OO-Browser user interface.
 330               ;; This must be called before the Env is loaded
 331               ;; and before br-env-file is set or it may
 332               ;; overwrite Env variable settings improperly.
 333               (setq br-lang-prefix
 334                    (br-env-read-language-prefix env-file))
 335               (let ((lang-symbol
 336                      (intern-soft (concat br-lang-prefix "browse")))
 337                     lang-function)
 338                 (if lang-symbol
 339                     (progn (setq lang-function (symbol-function lang-symbol))
 340                            (if (and (listp lang-function)
 341                                     (eq (car lang-function) 'autoload))
 342                                (load (car (cdr lang-function))))
 343                            ;; Initialize language-specific browser variables.
 344                            (funcall (intern-soft
 345                                      (concat br-lang-prefix "browse-setup"))
 346                                     env-file))))
 347
 348               (load-file env-file)
 349               (setq br-env-file env-file
 350                     br-env-name env-name)
 351               (br-init env-file) ;; initializes auxiliary Env file variables
 352
 353               ;; Prevent rebuilding of Environment
 354               (setq br-lib-prev-search-dirs br-lib-search-dirs
 355                     br-sys-prev-search-dirs br-sys-search-dirs)
 356
 357               (cond
 358                ((and br-env-spec (not no-build))
 359                 (setq br-loaded
 360                       (br-env-cond-build
 361                        env-file env-name
 362                        (if prompt "Build Environment `%s' now? "))))
 363                ;; Feature storage formats changed in V4.00, so all prior
 364                ;; Environments are obsolete.
 365                ((and (not no-build)
 366                      (or (null br-env-version)
 367                          (and (stringp br-env-version)
 368                               (string-lessp br-env-version "04.00"))))
 369                 (setq br-loaded
 370                       (br-env-cond-build
 371                        env-file env-name
 372                        (if prompt
 373                            "Env `%s' format is obsolete, rebuild it now? ")))
 374                 (if (not br-loaded)
 375                     (error "(OO-Browser): The Environment must be rebuilt before use.")))))
 376           ;;
 377           ;; Initialize OO-Browser Environment data structures in cases where
 378           ;; the Environment was not just built.
 379           (if (or br-env-spec br-loaded)
 380               nil
 381             (setq br-children-htable (hash-make br-children-alist)
 382                   br-features-htable (hash-make br-features-alist)
 383                   br-feature-paths-htable (hash-make br-feature-paths-alist)
 384                   br-sys-paths-htable (hash-make br-sys-paths-alist)
 385                   br-lib-paths-htable (hash-make br-lib-paths-alist)
 386                   br-sys-parents-htable
 387                   (hash-make br-sys-parents-alist)
 388                   br-lib-parents-htable
 389                   (hash-make br-lib-parents-alist)
 390                   )
 391             (br-env-set-htables t)
 392             (setq br-loaded t))
 393           (if (and (fboundp 'br-in-browser) (br-in-browser))
 394               (br-refresh))
 395           (message "Loading Environment...Done"))
 396       (if (file-exists-p env-file)
 397           (progn (beep)
 398                  (message "No read rights for Environment file, \"%s\"" env-file)
 399                  (sit-for 4))
 400         (setq br-loaded (br-env-load
 401                          (br-env-create env-file br-lang-prefix)
 402                          env-name t no-build))))
 403     br-loaded))
 404
 405 (defun br-env-save (&optional save-file)
 406   "Save the modified Environment to a file given by optional SAVE-FILE or `br-env-file'."
 407   (interactive (list (br-env-read-file-name "Save Environment to: ")))
 408   (if (or (not (stringp save-file)) (equal save-file ""))
 409       (setq save-file br-env-file))
 410   (setq save-file (expand-file-name save-file))
 411   (or (file-writable-p save-file)
 412       (error "Non-writable Environment file, \"%s\"" save-file))
 413   (let ((buf (get-file-buffer save-file)))
 414     (and buf (kill-buffer buf)))
 415   (let ((dir (or (file-name-directory save-file)
 416                  default-directory)))
 417     (or (file-writable-p dir)
 418         (error "Non-writable Environment directory, \"%s\"" dir)))
 419   (save-window-excursion
 420     (let ((standard-output (br-env-edit save-file))
 421           br-sym)
 422       (erase-buffer)
 423       (princ "\n(setq\nbr-env-version")
 424       (print br-version) ;; Yes, we need to use `br-version' here.
 425       ;; Save last build times, nil if none.
 426       (princ "\nbr-env-start-build-time")
 427       (print br-env-start-build-time)
 428       (princ "\nbr-env-end-build-time")
 429       (print br-env-end-build-time)
 430       ;; Save search dir settings.
 431       (br-env-save-mult-vars (cons (car br-env-mult-vars) nil))
 432       ;; Save language prefix, flag of whether is a specification,
 433       ;; children table, features table and feature paths table.
 434       (mapcar (function
 435                 (lambda (nm)
 436                   (if (setq br-sym (intern-soft (concat "br-" nm)))
 437                       (let ((nm-mid (string-match "-htable$" nm)))
 438                         (if nm-mid
 439                             (progn (princ "\nbr-") (princ (substring nm 0 nm-mid))
 440                                    (princ "-alist\n'")
 441                                    (hash-prin1 (symbol-value br-sym)))
 442                           (terpri) (princ br-sym) (princ "\n'")
 443                           (prin1 (symbol-value br-sym)) (terpri))))))
 444               br-env-single-vars)
 445       ;; Save paths and parents tables.
 446       (br-env-save-mult-vars (cdr br-env-mult-vars))
 447       (princ ")\n")
 448       (save-buffer)
 449       (kill-buffer standard-output))))
 450
 451 (defun br-env-stats (&optional arg)
 452   "Display a summary for the current Environment in the viewer window.
 453 With optional prefix ARG, display class totals in the minibuffer."
 454   (interactive "P")
 455   (let ((env-file (br-abbreviate-file-name br-env-file)))
 456     (if arg
 457         (message (br-env-totals-minibuffer))
 458       (br-funcall-in-view-window
 459        (concat br-buffer-prefix-info "Info*")
 460        (function
 461         (lambda ()
 462           (insert (cdr (assoc br-lang-prefix br-env-lang-name-alist)))
 463           (if (stringp br-env-name)
 464               (insert (format " Environment: `%s' - \"%s\""
 465                               br-env-name env-file))
 466             (insert (format " Environment: \"%s\"" env-file)))
 467           (center-line)
 468           (insert "\n\n")
 469           (insert (format "%s by version %s of the OO-Browser.\n\n"
 470                           (if br-env-spec "Specified but not yet built" "Built")
 471                           (or br-env-version "earlier than 02.09.03")))
 472           (if br-env-spec
 473               nil
 474             (if br-env-start-build-time
 475                 (insert (format "Start time of last build: %s\n"
 476                                 br-env-start-build-time)))
 477             (if br-env-end-build-time
 478                 (insert (format "  End time of last build: %s\n\n"
 479                                 br-env-end-build-time))))
 480           (insert (br-env-totals) "\n\n")
 481           (let ((undefined (br-undefined-classes)))
 482             (if undefined
 483                 (insert (format "Undefined classes: %s\n\n" undefined))))
 484           (mapcar
 485            (function
 486             (lambda (sys-lib)
 487               (insert (format "Top-level %s code directories:\n"
 488                               (car sys-lib)))
 489               (if (cdr sys-lib)
 490                   (progn (mapcar
 491                           (function
 492                            (lambda (dir)
 493                              (or (equal dir "")
 494                                  (insert
 495                                   (format "\t%s\n"
 496                                           (br-abbreviate-file-name dir))))))
 497                                  (cdr sys-lib))
 498                          (insert "\n"))
 499                 (insert "\t<None>\n\n"))))
 500            (list (cons "system-specific" br-sys-search-dirs)
 501                  (cons "reusable library"  br-lib-search-dirs)))
 502           (hypb:configuration)
 503           (insert "\n\n")
 504           (set-buffer-modified-p nil)))))))
 505
 506 (defun br-env-substitute-home (path)
 507   "If path is relative to user's home directory, shorten the path with ~/.
 508 Return modified or unmodified path."
 509   (if path
 510       (let ((home (regexp-quote (expand-file-name "~"))))
 511         (if (equal (string-match home path) 0)
 512             (concat "~" (substring path (match-end 0)))
 513           path))))
 514
 515 ;;; ************************************************************************
 516 ;;; Private functions
 517 ;;; ************************************************************************
 518
 519 (defun br-env-add-ref-classes (&optional htable-type)
 520   "Add classes to Environment which are referenced in it but not defined.
 521 With optional HTABLE-TYPE, affect only that part of the Environment.
 522 HTABLE-TYPE may be \"sys\"or \"lib\".  By default, add to both Library and
 523 whole Environment tables."
 524   ;;
 525   ;; This function must NOT call any `get-htable' type functions or it can
 526   ;; cause an infinite loop.
 527   (if (null htable-type) (setq htable-type "lib"))
 528   (let ((paths-htable (symbol-value
 529                        (intern-soft (concat "br-" htable-type
 530                                             (if htable-type "-")
 531                                             "paths-htable"))))
 532         (parents-htable
 533          (symbol-value
 534           (intern-soft (concat "br-" htable-type
 535                                (if htable-type "-")
 536                                "parents-htable"))))
 537         (parents-htable-name (concat htable-type "-parents"))
 538         (paths-htable-name (concat htable-type "-paths"))
 539         (parents (if (equal br-lang-prefix "java-") '("Object") nil))
 540         (class)
 541         (classes)
 542         (pars))
 543     (if paths-htable (setq classes (br-all-classes paths-htable)))
 544     (if parents-htable (setq pars (br-env-all-parents parents-htable)))
 545     (while pars
 546       (setq class (car pars)
 547             pars (cdr pars))
 548       (if (or (null class) (br-member class classes))
 549           nil
 550         (setq classes (cons class classes))
 551         (br-env-add-to-htables class parents parents-htable-name)
 552         (br-add-to-paths-htable
 553          class br-null-path
 554          (br-get-htable paths-htable-name))))
 555     (if (equal br-lang-prefix "java-")
 556         (br-env-add-to-htables "Object" nil parents-htable-name))))
 557
 558 (defun br-env-add-to-htables (class parents parents-htable-name)
 559   "Add CLASS with a list of PARENTS to PARENTS-HTABLE-NAME.
 560 PARENTS-HTABLE-NAME may be \"parents\", \"sys-parents\", or \"lib-parents\"."
 561   (if (null class)
 562       nil
 563     (setq parents-htable-name
 564           (symbol-value (intern-soft (concat "br-" parents-htable-name "-htable"))))
 565     (if parents-htable-name (hash-add parents class parents-htable-name))))
 566
 567 (defun br-env-all-parents (&optional htable-type)
 568   "Return list of all parent names in Environment or optional HTABLE-TYPE.
 569 HTABLE-TYPE may be \"sys\" or \"lib\". or an actual hash table."
 570   (apply 'append
 571          (hash-map 'car
 572                    (cond ((and (stringp htable-type)
 573                                (not (string-equal htable-type "")))
 574                           (br-get-htable (concat htable-type "-parents")))
 575                          ((hashp htable-type) htable-type)
 576                          (t (br-get-parents-htable))))))
 577
 578 (defun br-env-batch-build ()
 579   "Build Environments from specifications while running Emacs in batch mode (background).
 580 Invoke via a shell command line of the following form:
 581   cd <Br-Dir>; <Emacs> -batch -l ./br-start <Env-Spec-File-1> ... <Env-Spec-File-N> -f br-env-batch-build
 582
 583 where <Br-Dir>        = the directory in which your OO-Browser executable
 584                         Lisp code exists;
 585       <Emacs>         = the executable name that you use to run emacs or InfoDock;
 586       <Env-Spec-File> = a full pathname to an OO-Browser created Environment
 587                         file, usually named \"OOBR\"."
 588   (br-init-autoloads)
 589   (if (or (not (boundp 'br-directory)) (null br-directory)
 590           (not (file-exists-p br-directory)))
 591       (error "(br-env-batch-build): Set `br-directory' properly before use.")
 592     (let ((spec-file)
 593           (files (delq nil (mapcar 'buffer-file-name (buffer-list)))))
 594       (while (setq spec-file (car files))
 595         (setq files (cdr files))
 596         (br-env-load spec-file nil nil t) ;; sets br-env-file
 597         (kill-buffer nil)
 598         (br-env-build spec-file nil nil nil)))))
 599
 600 ;;; The following function is called by the compilation sentinel whenever a
 601 ;;; compilation finishes under versions of Emacs 19 or later.  (If you use
 602 ;;; Emacs 18, you would have to edit compilation-sentinel to call the
 603 ;;; function stored in `compilation-finish-function' as Emacs 19, compile.el
 604 ;;; does.
 605 ;;;
 606 ;;; If there already is a compilation-finish-function, save it and use it
 607 ;;; when not in a batch environment build.
 608 (setq compilation-original-finish-function
 609       (and (boundp 'compilation-finish-function)
 610            (not (eq compilation-finish-function 'br-env-batch-build-browse))
 611            compilation-finish-function)
 612       compilation-finish-function 'br-env-batch-build-browse)
 613
 614 (defun br-env-batch-build-browse (&rest args)
 615   (cond ((and (boundp 'compilation-last-buffer)
 616               (bufferp compilation-last-buffer))
 617          (set-buffer compilation-last-buffer))
 618         ((get-buffer "*compilation*")
 619          (set-buffer "*compilation*")))
 620   (cond ((not (string-match "oo-browser-env" compile-command))
 621          ;; Some other type of build.
 622          (if compilation-original-finish-function
 623              (apply compilation-original-finish-function args)))
 624         ((not (and (stringp mode-line-process)
 625                    (string-match "exit \\(OK\\|\\[0\\]\\)" mode-line-process)))
 626          ;; Build failed.
 627          nil)
 628         (t ;; Environment build was successful.
 629          (beep)
 630          (let* ((env-file (getenv "OO_BROWSER_ENV"))
 631                 (env-name (getenv "OO_BROWSER_ENV_NAME"))
 632                 (prompt
 633                  (progn
 634                    (if (equal env-name "nil") (setq env-name nil))
 635                    (if (equal env-name "t") (setq env-name t))
 636                    (format
 637                     "(OO-Browser):  Environment `%s' is built; browse it now? "
 638                     (or (and (stringp env-name) env-name)
 639                         (file-name-nondirectory env-file)))))
 640                 ;;
 641                 ;; Kill any buffers attached to Env files that will have been
 642                 ;; overwritten by the background build.  This avoids
 643                 ;; any `file changed on disk messages'.
 644                 (env-buffer (get-file-buffer env-file))
 645                 (env-ftrs-buffer (get-file-buffer
 646                                   (br-feature-tags-file-name env-file)))
 647                 (env-tags-buffer (get-file-buffer
 648                                   (expand-file-name
 649                                    "TAGS" (file-name-directory env-file)))))
 650            (if env-buffer (kill-buffer env-buffer))
 651            (if env-ftrs-buffer (kill-buffer env-ftrs-buffer))
 652            (if env-tags-buffer (kill-buffer env-tags-buffer))
 653            ;;
 654            (cond ((and (br-in-browser)
 655                        (equal env-file br-env-file))
 656                   ;; Since we are in the browser under the same Env as just
 657                   ;; built, reload it without prompting the user.
 658                   (br-env-load env-file env-name nil t)
 659                   (message
 660                    "(OO-Browser):  Environment `%s' built and reloaded successfully"
 661                   (or (and (stringp env-name) env-name)
 662                       (file-name-nondirectory br-env-file))))
 663                  ((y-or-n-p prompt)
 664                   (br-quit t)
 665                   ;; The quit above forces a reload of the Environment here.
 666                   (setq br-env-file env-file
 667                         br-env-name env-name)
 668                   (br-init env-file) ;; initializes auxiliary Env file variables
 669                   (br-env-browse env-file env-name)
 670                   (br-refresh)
 671                   )
 672                  ((equal env-file br-env-file)
 673                   ;; Ensure that new Env settings are loaded for the next
 674                   ;; time the browser is invoked.
 675                   (br-quit t)
 676                   (br-env-load env-file env-name nil t)
 677                   (message "(OO-Browser):  Reloaded Environment `%s' for later usage."
 678                            (or (and (stringp env-name) env-name)
 679                                (file-name-nondirectory br-env-file)))))))))
 680
 681 (defun br-env-cond-build (env-file env-name prompt)
 682   "Build current Environment from its specification and save it in ENV-FILE.
 683 ENV-NAME is used with PROMPT to prompt user before building the Environment.
 684 Return t iff current Environment gets built from specification.  Do not load
 685 the Environment after building."
 686   (let ((dir (or (file-name-directory env-file)
 687                  default-directory)))
 688     (if (not (file-writable-p dir))
 689         (progn (beep)
 690                (message "Unwritable Environment directory, \"%s\"" dir)
 691                (sit-for 4) nil)
 692       (if (or (not prompt)
 693               (y-or-n-p (format prompt
 694                                 (or (and (stringp env-name) env-name)
 695                                     env-file))))
 696           (progn (br-env-build env-file env-name 'prompt t) t)))))
 697
 698 (defun br-env-copy (to-br)
 699   "Copy `br-' Environment to or from `br-lang-prefix' language variables.
 700 If TO-BR is non-nil, copy from language-specific variables to browser
 701 variables.  Otherwise, do copy in the reverse direction."
 702   (let* ((var1) (var2)
 703          (copy-func
 704           (if to-br (function
 705                      (lambda ()
 706                        (if (boundp var2) (set var1 (symbol-value var2)))))
 707             (function (lambda ()
 708                         (if (boundp var1) (set var2 (symbol-value var1))))))))
 709     (mapcar (function
 710               (lambda (nm)
 711                (setq var1 (intern (concat "br-" nm))
 712                      var2 (intern (concat br-lang-prefix nm)))
 713                (funcall copy-func)))
 714             (append
 715               '("env-file" "env-name" "env-version"
 716                 "env-start-build-time" "env-end-build-time"
 717                 "lib-search-dirs"
 718                 "lib-prev-search-dirs" "lib-parents-htable"
 719                 "lib-paths-htable" "sys-search-dirs"
 720                 "sys-prev-search-dirs" "sys-parents-htable"
 721                 "sys-paths-htable" "paths-htable" "parents-htable")
 722               br-env-single-vars))))
 723
 724 (defun br-env-create-alists ()
 725   "Create all empty Environment association lists."
 726   (setq br-children-alist    nil
 727         br-sys-paths-alist   nil  br-lib-paths-alist nil
 728         br-sys-parents-alist nil  br-lib-parents-alist nil
 729         br-paths-alist       nil  br-parents-alist nil
 730         br-features-alist    nil  br-feature-paths-alist nil))
 731
 732 (defun br-env-create-htables ()
 733   "Create all empty Environment hash tables."
 734   (setq br-children-htable (hash-make 0)
 735         br-sys-paths-htable (hash-make 0)
 736         br-sys-parents-htable (hash-make 0)
 737         br-lib-paths-htable (hash-make 0)
 738         br-lib-parents-htable (hash-make 0)
 739         br-paths-htable (hash-make 0)
 740         br-parents-htable (hash-make 0)
 741         br-features-htable (hash-make 0)
 742         br-feature-paths-htable (hash-make 0)))
 743
 744 (defun br-env-default-file (&optional directory)
 745   "Search up current or optional DIRECTORY tree for an OO-Browser environment file.
 746 Return file name found, the value of `br-env-file' if non-nil, or else the
 747 value of `br-env-default-file'.  All return values are expanded to absolute
 748 paths before being returned."
 749   (let ((path directory)
 750         (oo-browser-file))
 751     (while (and (stringp path)
 752                 (setq path (file-name-directory path))
 753                 (setq path (directory-file-name path))
 754                 ;; Not at root directory
 755                 (not (string-match ":?/\\'" path))
 756                 ;; No environment file
 757                 (not (file-exists-p
 758                       (setq oo-browser-file (expand-file-name
 759                                        br-env-default-file path)))))
 760       (setq oo-browser-file nil))
 761     (expand-file-name (or oo-browser-file br-env-file br-env-default-file))))
 762
 763 (defun br-env-edit (env-file)
 764   "Read in ENV-FILE for editing and disable undo and backups within it."
 765   (prog1 (set-buffer (funcall br-find-file-noselect-function env-file))
 766     (buffer-disable-undo (current-buffer))
 767     (make-local-variable 'make-backup-files)
 768     (make-local-variable 'backup-inhibited)
 769     (setq make-backup-files nil
 770           backup-inhibited t
 771           buffer-read-only nil)))
 772
 773 (defun br-env-file-sym-val (symbol-name)
 774   "Given a SYMBOL-NAME, a string, find its value in the current Environment file.
 775 Only search for the SYMBOL-NAME from the current point in the buffer.
 776 Return cons whose car is t iff SYMBOL-NAME was found and then whose cdr is the
 777 non-quoted value found."
 778   (set-buffer (funcall br-find-file-noselect-function br-env-file))
 779   (save-excursion
 780     (if (search-forward symbol-name nil t)
 781         (let ((standard-input (current-buffer)))
 782           (cons t (eval (read)))))))
 783
 784 (defun br-env-try-load (env-file default-file)
 785   "Try to load a complete Environment, initially given by ENV-FILE.
 786 If an Environment specification is selected, the user will be prompted
 787 whether or not to build it.  If ENV-FILE is not a string, the function will
 788 prompt for an Environment to load.  DEFAULT-FILE is the default file to use
 789 when an empty value is given at the Environment file prompt.
 790
 791 Return the name of the Environment file that was loaded or nil."
 792   (if (stringp env-file)
 793         nil
 794     (if (stringp default-file)
 795         nil
 796       (setq default-file (br-env-default-file)))
 797     (setq env-file (br-env-read-file-name
 798                     "OO-Browser Environment to load: "
 799                     default-file default-file t)))
 800   (br-env-load env-file nil 'prompt nil))
 801
 802 (defun br-env-get-dirs (prompt)
 803   "PROMPT for and return list of directory names.
 804 PROMPT must contain a %d somewhere in it, so dir # may be inserted."
 805   (let ((dir) (dirs) (num 1) (default ""))
 806     (while (not (string-equal
 807                  "" (setq dir (read-file-name
 808                                (format prompt num) default default t))))
 809       (if (file-directory-p dir)
 810           (setq dirs (cons (file-name-as-directory dir) dirs)
 811                 num (1+ num)
 812                 default "")
 813         (beep)
 814         (setq default dir)))
 815     (nreverse dirs)))
 816
 817 (defun br-env-init (env-file same-lang same-env)
 818   "Load or build ENV-FILE if non-nil.
 819 Otherwise, use `br-env-file' if non-nil or if not, interactively prompt for
 820 Environment name.  SAME-LANG should be non-nil if invoking the OO-Browser on
 821 the same language again.  SAME-ENV should be non-nil if invoking the
 822 OO-Browser on the same Environment again.  br-sys/lib-search-dirs variables
 823 should be set before this function is called.
 824
 825 Return the name of the current Environment file unless load attempt fails,
 826 then return nil."
 827   (cond
 828
 829    ;; Specific environment requested
 830    (env-file
 831     ;; Create or load spec and load or build Environment
 832     (setq env-file (br-env-try-load env-file br-env-file)))
 833
 834    ;; First invocation on this lang
 835    ((and (null br-sys-search-dirs) (null br-lib-search-dirs))
 836     ;; Create or load spec and load or build Environment
 837     (setq env-file
 838           (br-env-try-load (or br-env-file (br-env-create)) br-env-file)))
 839
 840    ;; Non-first invocation, code search paths have been set, possibly default Env
 841    (t
 842     (setq env-file br-env-file)
 843     (cond
 844      ;; Continue browsing an Environment
 845      (same-env nil)
 846      (same-lang
 847       ;; But code search paths have changed, so rebuild Env
 848       (or (eq br-sys-search-dirs br-sys-prev-search-dirs)
 849           (br-build-sys-htable))
 850       (or (eq br-lib-search-dirs br-lib-prev-search-dirs)
 851           (br-build-lib-htable)))
 852      ;; Request to browse a different language Env
 853      (t
 854       (setq env-file (br-env-try-load
 855                       (or br-env-file (br-env-create)) br-env-file))))))
 856   ;; Return current Env file name unless load attempt failed, then return nil.
 857   env-file)
 858
 859 (defun *br-env-internal-structures* ()
 860   "Display values of internal data structures in viewer buffer."
 861   (interactive)
 862   (br-funcall-in-view-window
 863    (concat br-buffer-prefix-info "Info*")
 864    (function
 865     (lambda ()
 866       (let ((standard-output (current-buffer)))
 867         (mapcar
 868          (function
 869           (lambda (sym)
 870             (mapcar
 871              (function (lambda (obj)
 872                          (princ obj)))
 873              (list "!!! " (symbol-name sym) " !!!\n\n"
 874                    (symbol-value sym) "\n\f\n"))
 875             ))
 876          '(br-children-htable
 877            br-parents-htable
 878            br-paths-htable
 879            br-features-htable
 880            br-feature-paths-htable
 881            br-sys-search-dirs
 882            br-sys-paths-htable
 883            br-sys-parents-htable
 884            br-lib-search-dirs
 885            br-lib-paths-htable
 886            br-lib-parents-htable
 887            br-lang-prefix
 888            br-env-spec)))))))
 889
 890 (defun br-env-lang-dialog-box (dialog-box)
 891   "Prompt user with DIALOG-BOX and return selected value.
 892 Assumes caller has checked that `dialog-box' function exists."
 893   (let ((echo-keystrokes 0)
 894         event-obj
 895         event)
 896     ;; Add a cancel button to dialog box.
 897     (setq dialog-box (append dialog-box (list nil '["Cancel" abort t])))
 898     (popup-dialog-box dialog-box)
 899     (catch 'br-env-done
 900       (while t
 901         (setq event (next-command-event event)
 902               event-obj (event-object event))
 903         (cond ((and (menu-event-p event)
 904                     (memq event-obj '(abort menu-no-selection-hook)))
 905                (signal 'quit nil))
 906               ((button-release-event-p event) ;; don't beep twice
 907                nil)
 908               ((menu-event-p event)
 909                (throw 'br-env-done (eval event-obj)))
 910               (t
 911                (beep)
 912                (message "Please answer the dialog box.")))))))
 913
 914 (defun br-env-lang-var (lang-prefix)
 915   "Create language-specific Environment variables for LANG-PREFIX."
 916   (eval (list 'defvar (intern (concat lang-prefix "env-version"))
 917               nil
 918               "Version of the OO-Browser used to build the current Environment or nil."))
 919   (eval (list 'defvar (intern (concat lang-prefix "env-file"))
 920               br-env-default-file
 921               "*File in which to save Environment.")))
 922
 923 (defun br-env-load-matching-htables (changed-types-list)
 924   (let ((still-changed-types))
 925     (if (file-readable-p br-env-file)
 926         (unwind-protect
 927             (progn
 928               (let ((buf (get-file-buffer br-env-file)))
 929                 (and buf (kill-buffer buf)))
 930               (set-buffer (funcall br-find-file-noselect-function br-env-file))
 931               (goto-char (point-min))
 932               (mapcar
 933                 (function
 934                   (lambda (type)
 935                     (let* ((search-dirs (concat "br-" type "-search-dirs"))
 936                            (prev-dirs (concat "br-" type "-prev-search-dirs"))
 937                            (paths (concat "br-" type "-paths-htable"))
 938                            (parents (concat "br-" type "-parents-htable"))
 939                            (dirs-val (cdr (br-env-file-sym-val search-dirs))))
 940                       (if (equal dirs-val (symbol-value (intern search-dirs)))
 941                           (and (br-member type changed-types-list)
 942                                (progn (set (intern paths)
 943                                            (cdr (br-env-file-sym-val paths)))
 944                                       (set (intern parents)
 945                                            (cdr (br-env-file-sym-val parents)))
 946                                       (set (intern prev-dirs)
 947                                            (symbol-value
 948                                              (intern search-dirs)))))
 949                         (setq still-changed-types
 950                               (cons type still-changed-types))))))
 951                 '("sys" "lib"))
 952               )
 953           nil))
 954     (nreverse still-changed-types)))
 955
 956 (defun br-env-read-file-name (prompt &optional dir default must-match)
 957   "Read file name, prompting with PROMPT and completing in directory DIR.
 958 Beep and re-prompt if a directory name is given rather than a file name.
 959 The file name read is processed by `substitute-in-file-name' but is
 960 not expanded (call `expand-file-name' for this).
 961
 962 Default name to DEFAULT if user enters a null string.  (If DEFAULT is
 963 omitted, the visited file name is used.)  Fourth arg MUST-MATCH non-nil
 964 means require existing file's name.  Non-nil and non-t means also require
 965 confirmation after completion.  DIR defaults to current buffer's directory
 966 default."
 967   (or dir (setq dir (file-name-directory (or default (br-env-default-file)))))
 968   (or default (setq default (br-env-default-file)))
 969   (if noninteractive
 970       default
 971     (let ((env default))
 972       (while (and (setq env (read-file-name
 973                              prompt
 974                              (br-env-substitute-home env) env must-match))
 975                   (file-directory-p env))
 976         (beep))
 977       env)))
 978
 979 (defun br-env-read-language-prefix (env-file)
 980   (save-excursion
 981     (set-buffer (find-file-noselect env-file))
 982     (save-restriction
 983       (widen)
 984       (goto-char (point-min))
 985       (if (search-forward "br-lang-prefix" nil t)
 986           (progn (forward-line 1)
 987                  ;; Eval removes quote from in front of lang-string
 988                  ;; value which is read from the Env file.
 989                  (eval (read (current-buffer))))))))
 990
 991 (defun br-env-save-mult-vars (mult-vars)
 992   (let ((br-sym))
 993     (mapcar
 994       (function
 995         (lambda (suffix)
 996           (mapcar
 997             (function
 998               (lambda (type-str)
 999                 (setq br-sym (intern-soft
1000                                (concat "br-" type-str suffix)))
1001                 (if (and br-sym (boundp br-sym))
1002                     (let* ((nm (symbol-name br-sym))
1003                            (nm-mid (string-match "-htable$" nm)))
1004                       (if nm-mid
1005                           (progn (terpri) (princ (substring nm 0 nm-mid))
1006                                  (princ "-alist\n'")
1007                                  (hash-prin1 (symbol-value br-sym)))
1008                         (terpri) (princ br-sym) (princ "\n'")
1009                         (prin1 (symbol-value br-sym))
1010                         (terpri))))))
1011             '("sys-" "lib-"))))
1012       mult-vars)))
1013
1014 (defun br-env-set-htables (&optional skip-children)
1015   (br-env-add-ref-classes "lib")
1016   (br-env-add-ref-classes "sys")
1017   ;; Make System entries override Library entries which they duplicate, since
1018   ;; this is generally more desirable than merging the two.  Don't do this
1019   ;; for the paths-htable, however, since the value is the union of both
1020   ;; values.
1021   (br-merge-paths-htables)
1022   (br-merge-parents-htables)
1023   (if skip-children nil (br-build-children-htable)))
1024
1025 (defun br-env-select-lang ()
1026   "Interactively select and return value for `br-lang-prefix'."
1027   (let ((n 0) (nlangs (length br-env-lang-avector))
1028         (lang-prompt)
1029         ;; Use dialog box if last user event involved the mouse.
1030         (use-dialog-box (and (fboundp 'popup-dialog-box)
1031                              (fboundp 'button-press-event-p)
1032                              (or (button-press-event-p last-command-event)
1033                                  (button-release-event-p last-command-event)
1034                                  (menu-event-p last-command-event)))))
1035     ;; Create a prompt numbering each OO-Browser language available.
1036     (setq lang-prompt
1037           (if use-dialog-box
1038               (mapcar
1039                (function (lambda (lang)
1040                            (setq n (1+ n))
1041                            (vector lang (list 'identity n) 't)))
1042                (mapcar 'car br-env-lang-avector))
1043             (mapconcat
1044              (function (lambda (lang)
1045                          (setq n (1+ n))
1046                          (format "%d\) %s" n lang)))
1047              (mapcar 'car br-env-lang-avector)
1048              "; ")))
1049     ;; Prompt user.
1050     (while (progn
1051              (setq n (if use-dialog-box
1052                          (br-env-lang-dialog-box
1053                           (cons "Choose language to browse: " lang-prompt))
1054                        ;; Otherwise, prompt in the minibuffer.
1055                        (read-number (concat lang-prompt ": ") t)))
1056              (or (< n 1) (> n nlangs)))
1057       (beep))
1058     (cdr (aref br-env-lang-avector (1- n)))))
1059
1060 (defun br-env-totals-minibuffer ()
1061   "Return a one line string of Environment class totals."
1062   (let ((sys (length (br-all-classes "sys")))
1063         (lib (length (br-all-classes "lib"))))
1064     (format "Total unique classes: %d  (System: %d; Library: %d)"
1065             (+ sys lib) sys lib)))
1066
1067 (defun br-env-totals ()
1068   "Return string of Environment class totals."
1069   (let* ((sys-class-list (br-all-classes "sys"))
1070          (lib-class-list (br-all-classes "lib"))
1071          (sys-classes (length sys-class-list))
1072          (lib-classes (length lib-class-list))
1073          (duplicates (car (br-all-classes nil t)))
1074          (sys-interfaces 0) (lib-interfaces 0)
1075          sys-default-classes lib-default-classes
1076          count)
1077     (if (br-interface-support-p)
1078         (setq sys-interfaces
1079               (length (delq nil (mapcar 'br-interface-p sys-class-list)))
1080               lib-interfaces
1081               (length (delq nil (mapcar 'br-interface-p lib-class-list)))))
1082     (setq sys-default-classes
1083           (length (delq nil (mapcar 'br-default-class-p sys-class-list)))
1084           lib-default-classes
1085           (length (delq nil (mapcar 'br-default-class-p lib-class-list))))
1086     (concat
1087      (format
1088 "%s                       System    Library    Subtotals
1089 ------------------------------------------------------
1090 Unique Env Classes:    %6d       %4d        %5d
1091 Default Classes:       %6d       %4d        %5d\n"
1092        (if (null duplicates)
1093            ""
1094          (setq count (length duplicates))
1095          (format "%d DUPLICATE CLASS%s TO CONSIDER ELIMINATING:\n\t%s\n\n"
1096                  count (if (= count 1) "" "ES") duplicates))
1097        ;; Unique Env Classes
1098        (- sys-classes sys-default-classes sys-interfaces)
1099        (- lib-classes lib-default-classes lib-interfaces)
1100        (+ (- sys-classes sys-default-classes sys-interfaces)
1101           (- lib-classes lib-default-classes lib-interfaces))
1102        ;; Default Classes
1103        sys-default-classes lib-default-classes
1104        (+ sys-default-classes lib-default-classes))
1105      ;;
1106      (if (br-interface-support-p)
1107          (format
1108 "Interfaces:            %6d       %4d        %5d\n"
1109            ;; Interfaces
1110            sys-interfaces lib-interfaces (+ sys-interfaces lib-interfaces)))
1111      ;; Totals
1112      (format
1113 "------------------------------------------------------
1114             Totals:    %6d       %4d        %5d"
1115          sys-classes lib-classes (+ sys-classes lib-classes )))))
1116
1117 (defun br-env-validate-arg-strings (caller-name env-file env-name)
1118   "Called from CALLER-NAME function, validate and set ENV-FILE and ENV-NAME.
1119 Return a cons of these two values."
1120   (br-names-initialize)
1121   (if (and (stringp env-name) (null env-file))
1122       (setq env-file (br-name-get-env-file env-name)))
1123   (if (stringp env-file)
1124       (progn (if (string-match "-FTR$" env-file)
1125                  (setq env-file (substring env-file 0 (match-beginning 0))))
1126              (setq env-file (expand-file-name env-file))
1127              (if (null env-name)
1128                  (setq env-name (br-name-get env-file)))
1129              (let ((env-directory))
1130                (if (not (file-exists-p
1131                          (setq env-directory
1132                                (file-name-directory
1133                                 (expand-file-name env-file)))))
1134                    ;; Directory containing filename no longer exists.
1135                    ;; Trigger error.
1136                    (error "(%s): %s's directory, \"%s\" no longer exists."
1137                           caller-name env-name env-directory))))
1138     (error "(%s): Invalid Env file: `%s'"
1139            caller-name env-file))
1140   (if (null env-name)
1141 ; Old code that could improperly attach wrong an old env name to a new env file.
1142 ;      (if br-env-name
1143 ;         (setq env-name br-env-name)
1144 ;       (setq env-name (br-name-add nil env-file)))
1145       (setq env-name (br-name-add nil env-file)))
1146   (cons env-file env-name))
1147
1148 ;;; ************************************************************************
1149 ;;; Internal variables
1150 ;;; ************************************************************************
1151
1152 (defvar br-env-start-build-time nil
1153   "The time at which the last build of the current Environment was started or nil.")
1154
1155 (defvar br-env-end-build-time nil
1156   "The time at which the last build of the current Environment finished or nil.")
1157
1158 (defvar br-env-version nil
1159   "Version of the OO-Browser used to build the current Environment or nil.")
1160
1161 (defconst br-env-mult-vars
1162   '("search-dirs" "paths-htable" "parents-htable")
1163   "Descriptors of multiple copy variables saved as part of an Environment.")
1164 (defconst br-env-single-vars
1165   '("lang-prefix" "env-spec" "children-htable" "features-htable"
1166     "feature-paths-htable")
1167   "Descriptors of singular variables saved as part of an Environment.")
1168
1169 (defvar br-env-spec nil
1170   "Non-nil value means Environment specification has been given but not yet built.
1171 Nil means current Environment has been built, though it may still require
1172 updating.  The value is language-specific.")
1173
1174 (defvar br-env-lang-avector
1175   '[("C++/C"   . "c++-")
1176     ("Eiffel"  . "eif-")
1177     ("Info"    . "info-")
1178     ("Java"    . "java-")
1179     ("Lisp"    . "clos-")
1180     ("Obj-C"   . "objc-")
1181     ("Python"  . "python-")
1182     ("Smalltalk" . "smt-")]
1183   "Association vector of (LANGUAGE-NAME-ABBREV . LANGUAGE-PREFIX-STRING) elements of OO-Browser languages.")
1184
1185 (defvar br-env-lang-name-alist
1186   '(("c++-" . "C++")
1187     ("eif-" . "Eiffel")
1188     ("info-" . "Info")
1189     ("java-" . "Java")
1190     ("clos-" . "CLOS")
1191     ("objc-" . "Objective-C")
1192     ("python-" . "Python")
1193     ("smt-" . "Smalltalk"))
1194   "Association list of (LANGUAGE-PREFIX-STRING . LANGUAGE-NAME) elements of OO-Browser languages.")
1195
1196 (mapcar 'br-env-lang-var (mapcar 'cdr br-env-lang-avector))
1197
1198 (provide 'br-env)