Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 131b0175ea99
children
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
4 ;; SUMMARY: OO-Browser Environment support functions. 4 ;; SUMMARY: OO-Browser Environment support functions.
5 ;; USAGE: GNU Emacs Lisp Library 5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: oop, tools 6 ;; KEYWORDS: oop, tools
7 ;; 7 ;;
8 ;; AUTHOR: Bob Weiner 8 ;; AUTHOR: Bob Weiner
9 ;; ORG: Motorola Inc. 9 ;; ORG: InfoDock Associates
10 ;; 10 ;;
11 ;; ORIG-DATE: 8-Jun-90 11 ;; ORIG-DATE: 8-Jun-90
12 ;; LAST-MOD: 20-Sep-95 at 14:59:03 by Bob Weiner 12 ;; LAST-MOD: 21-Feb-97 at 17:22:39 by Bob Weiner
13 ;; 13 ;;
14 ;; Copyright (C) 1989-1995 Free Software Foundation, Inc. 14 ;; Copyright (C) 1989-1995, 1997 Free Software Foundation, Inc.
15 ;; See the file BR-COPY for license information. 15 ;; See the file BR-COPY for license information.
16 ;; 16 ;;
17 ;; This file is part of the OO-Browser. 17 ;; This file is part of the OO-Browser.
18 18
19 ;;; ************************************************************************ 19 ;;; ************************************************************************
179 179
180 Return the name of the Environment specification file that was created." 180 Return the name of the Environment specification file that was created."
181 (interactive) 181 (interactive)
182 (if env-file 182 (if env-file
183 (read-string 183 (read-string
184 (format "Please specify the \"%s\" Environment (Hit RTN to begin)." 184 (format "Please specify the \"%s\" Environment (Hit RET to begin)."
185 (file-name-nondirectory env-file))) 185 (file-name-nondirectory env-file)))
186 (setq env-file (br-env-default-file) 186 (setq env-file (br-env-default-file)
187 env-file (read-file-name 187 env-file (read-file-name
188 (format "Create Env spec file (default \"%s\"): " 188 (format "Create Env spec file (default \"%s\"): "
189 (br-relative-path env-file)) 189 (br-relative-path env-file))
190 (file-name-directory env-file) 190 (file-name-directory env-file)
191 env-file nil))) 191 env-file nil)))
192 (setq env-file (expand-file-name env-file)) 192 (setq env-file (expand-file-name env-file))
193 ;; Display Env spec if previous one existed 193 ;; Display Env spec if previous one existed
194 (and (equal env-file br-env-file) (file-readable-p env-file) (br-env-stats)) 194 (and (equal env-file br-env-file) (file-readable-p env-file) (br-env-stats))
195 (let ((prompt "System search dir #%d (RTN to end): ") 195 (let ((prompt "System search dir #%d (RET to end): ")
196 (br-env-spec t) 196 (br-env-spec t)
197 br-sys-search-dirs br-lib-search-dirs 197 br-sys-search-dirs br-lib-search-dirs
198 br-lang-prefix 198 br-lang-prefix
199 br-children-htable 199 br-children-htable
200 br-sys-paths-htable 200 br-sys-paths-htable
204 br-paths-htable 204 br-paths-htable
205 br-parents-htable) 205 br-parents-htable)
206 (br-env-create-htables) 206 (br-env-create-htables)
207 (setq br-lang-prefix (or lang-prefix (br-env-select-lang)) 207 (setq br-lang-prefix (or lang-prefix (br-env-select-lang))
208 br-sys-search-dirs (br-env-get-dirs prompt) 208 br-sys-search-dirs (br-env-get-dirs prompt)
209 prompt "Library search dir #%d (RTN to end): " 209 prompt "Library search dir #%d (RET to end): "
210 br-lib-search-dirs (br-env-get-dirs prompt)) 210 br-lib-search-dirs (br-env-get-dirs prompt))
211 ;; Now since user has not aborted, set real variables 211 ;; Now since user has not aborted, set real variables
212 (setq br-env-spec t) 212 (setq br-env-spec t)
213 (br-env-save env-file) 213 (br-env-save env-file)
214 ;; If called interactively and re-specifying current Env, then also 214 ;; If called interactively and re-specifying current Env, then also
284 (br-env-stats) 284 (br-env-stats)
285 (br-env-cond-build 285 (br-env-cond-build
286 env-file 286 env-file
287 (if prompt 287 (if prompt
288 "Environment file format is obsolete, rebuild it? "))))) 288 "Environment file format is obsolete, rebuild it? ")))))
289 ;; Ensure that OO-Browser support libraries for the current
290 ;; language are loaded, since this function may be called without
291 ;; invoking the OO-Browser user interface.
292 (let ((lang-symbol (intern-soft (concat br-lang-prefix "browse")))
293 lang-setup-symbol
294 lang-function)
295 (if lang-symbol
296 (progn (setq lang-function (symbol-function lang-symbol))
297 (and (listp lang-function) (eq (car lang-function) 'autoload)
298 (load (car (cdr lang-function)))
299 ;; Initialize language-specific browser variables.
300 (setq lang-setup-symbol (intern-soft (concat br-lang-prefix "browse-setup")))
301 (funcall lang-setup-symbol)))))
289 nil) 302 nil)
290 (if (file-exists-p env-file) 303 (if (file-exists-p env-file)
291 (progn (beep) 304 (progn (beep)
292 (message "No read rights for Envir file, \"%s\"" env-file) 305 (message "No read rights for Envir file, \"%s\"" env-file)
293 (sit-for 4)) 306 (sit-for 4))
357 (interactive "P") 370 (interactive "P")
358 (let ((env-file (abbreviate-file-name br-env-file))) 371 (let ((env-file (abbreviate-file-name br-env-file)))
359 (if arg 372 (if arg
360 (message "Envir \"%s\": %s" env-file (br-env-totals)) 373 (message "Envir \"%s\": %s" env-file (br-env-totals))
361 (br-funcall-in-view-window 374 (br-funcall-in-view-window
362 (concat br-buffer-prefix-info "Info") 375 (concat br-buffer-prefix-info "Info*")
363 (function 376 (function
364 (lambda () 377 (lambda ()
365 (insert (format "Environment: \"%s\"" env-file)) 378 (insert (format "Environment: \"%s\"" env-file))
366 (center-line) 379 (center-line)
367 (insert "\n\n") 380 (insert "\n\n")
564 "Search up current or optional DIRECTORY tree for an OO-Browser environment file. 577 "Search up current or optional DIRECTORY tree for an OO-Browser environment file.
565 Return file name found, the value of 'br-env-file' if non-nil, or else the 578 Return file name found, the value of 'br-env-file' if non-nil, or else the
566 value of 'br-env-default-file'. All return values are expanded to absolute 579 value of 'br-env-default-file'. All return values are expanded to absolute
567 paths before being returned." 580 paths before being returned."
568 (let ((path directory) 581 (let ((path directory)
569 (oobr-file)) 582 (oo-browser-file))
570 (while (and (stringp path) 583 (while (and (stringp path)
571 (setq path (file-name-directory path)) 584 (setq path (file-name-directory path))
572 (setq path (directory-file-name path)) 585 (setq path (directory-file-name path))
573 ;; Not at root directory 586 ;; Not at root directory
574 (not (string-match ":?/\\'" path)) 587 (not (string-match ":?/\\'" path))
575 ;; No environment file 588 ;; No environment file
576 (not (file-exists-p 589 (not (file-exists-p
577 (setq oobr-file (expand-file-name 590 (setq oo-browser-file (expand-file-name
578 br-env-default-file path))))) 591 br-env-default-file path)))))
579 (setq oobr-file nil)) 592 (setq oo-browser-file nil))
580 (expand-file-name (or oobr-file br-env-file br-env-default-file)))) 593 (expand-file-name (or oo-browser-file br-env-file br-env-default-file))))
581 594
582 (defun br-env-file-sym-val (symbol-name) 595 (defun br-env-file-sym-val (symbol-name)
583 "Given a SYMBOL-NAME, a string, find its value in the current Environment file. 596 "Given a SYMBOL-NAME, a string, find its value in the current Environment file.
584 Assume the Environment file to use is attached to the current buffer. 597 Assume the Environment file to use is attached to the current buffer.
585 Only search for the SYMBOL-NAME from the current point in the buffer. 598 Only search for the SYMBOL-NAME from the current point in the buffer.
673 686
674 (defun *br-env-internal-structures* () 687 (defun *br-env-internal-structures* ()
675 "Display values of internal data structures in viewer buffer." 688 "Display values of internal data structures in viewer buffer."
676 (interactive) 689 (interactive)
677 (br-funcall-in-view-window 690 (br-funcall-in-view-window
678 (concat br-buffer-prefix-info "Info") 691 (concat br-buffer-prefix-info "Info*")
679 (function 692 (function
680 (lambda () 693 (lambda ()
681 (let ((standard-output (current-buffer))) 694 (let ((standard-output (current-buffer)))
682 (mapcar 695 (mapcar
683 (function 696 (function
869 "Non-nil value means Environment specification has been given but not yet built. 882 "Non-nil value means Environment specification has been given but not yet built.
870 Nil means current Environment has been built, though it may still require 883 Nil means current Environment has been built, though it may still require
871 updating. Value is language-specific.") 884 updating. Value is language-specific.")
872 885
873 (defvar br-env-lang-avector 886 (defvar br-env-lang-avector
874 '[("C++" . "c++-") 887 '[("C++/C" . "c++-")
875 ("Eiffel" . "eif-") 888 ("Eiffel" . "eif-")
876 ("Info" . "info-") 889 ("Info" . "info-")
877 ("Java" . "java-") 890 ("Java" . "java-")
878 ("Lisp" . "clos-") 891 ("Lisp" . "clos-")
879 ("Obj-C" . "objc-") 892 ("Obj-C" . "objc-")