/[cmucl]/src/tools/config.lisp
ViewVC logotype

Contents of /src/tools/config.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Mon Jul 26 15:16:03 1993 UTC (20 years, 8 months ago) by ram
Branch: MAIN
CVS Tags: RELEASE_18a, RELEASE_18b
Branch point for: RELENG_18
Changes since 1.3: +19 -8 lines
Add support for loading Motif stuff.
 
1 ;;; -*- Mode: Lisp; Package: System -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8 ;;;
9 (ext:file-comment
10 "$Header: /tiger/var/lib/cvsroots/cmucl/src/tools/config.lisp,v 1.4 1993/07/26 15:16:03 ram Exp $")
11 ;;;
12 ;;; **********************************************************************
13 ;;;
14 ;;; Utility to load subsystems and save a new core.
15 ;;;
16 (in-package "USER")
17
18
19 (block abort
20 (let ((output-file #p"library:lisp.core")
21 (load-clm t)
22 (load-clx t)
23 (load-hemlock t)
24 (other ()))
25 (loop
26 (fresh-line)
27 (format t " 1: specify result file (currently ~S)~%"
28 (namestring output-file))
29 (format t " 2: toggle loading of the CLX X library, currently ~
30 ~:[dis~;en~]abled.~%"
31 load-clx)
32 (format t " 3: toggle loading of Motif and the graphical debugger, ~
33 currently ~:[dis~;en~]abled.~
34 ~:[~% (would force loading of CLX.)~;~]~%"
35 load-clm load-clx)
36 (format t " 4: toggle loading the Hemlock editor, currently ~
37 ~:[dis~;en~]abled.~
38 ~:[~% (would force loading of CLX.)~;~]~%"
39 load-hemlock load-clx)
40 (format t " 5: specify some site-specific file to load.~@
41 ~@[ Current files:~%~{ ~S~%~}~]"
42 (mapcar #'namestring other))
43 (format t " 6: configure according to current options.~%")
44 (format t " 7: abort the configuration process.~%")
45 (format t "~%Option number: ")
46 (force-output)
47 (flet ((file-prompt (prompt)
48 (format t prompt)
49 (force-output)
50 (pathname (string-trim " " (read-line)))))
51 (let ((res (ignore-errors (read-from-string (read-line)))))
52 (case res
53 (1
54 (setq output-file (file-prompt "Result core file name: ")))
55 (2
56 (unless (setq load-clx (not load-clx))
57 (setq load-hemlock nil)))
58 (3
59 (when (setq load-clm (not load-clm))
60 (setq load-clx t)))
61 (4
62 (when (setq load-hemlock (not load-hemlock))
63 (setq load-clx t)))
64 (5
65 (setq other
66 (append other
67 (list (file-prompt "File(s) to load ~
68 (can have wildcards): ")))))
69 (6 (return))
70 (7
71 (format t "~%Aborted.~%")
72 (return-from abort))))))
73
74 (gc-off)
75 (when load-clx
76 (setf *features* (delete :no-clx *features* :test #'eq))
77 (load "library:subsystems/clx-library"))
78 (when load-clm
79 (setf *features* (delete :no-clm *features* :test #'eq))
80 (load "library:subsystems/clm-library"))
81 (when load-hemlock
82 (setf *features* (delete :no-hemlock *features* :test #'eq))
83 (load "library:subsystems/hemlock-library"))
84 (dolist (f other) (load f))
85
86 (setq *info-environment*
87 (list* (make-info-environment :name "Working")
88 (compact-info-environment (first *info-environment*)
89 :name "Auxiliary")
90 (rest *info-environment*)))
91
92 (when (probe-file output-file)
93 (multiple-value-bind
94 (ignore old new)
95 (rename-file output-file
96 (concatenate 'string (namestring output-file)
97 ".BAK"))
98 (declare (ignore ignore))
99 (format t "~&Saved ~S as ~S.~%" (namestring old) (namestring new))))
100
101 ;;
102 ;; Enable the garbage collector. But first fake it into thinking that
103 ;; we don't need to garbage collect. The save-lisp is going to call
104 ;; purify so any garbage will be collected then.
105 (setf lisp::*need-to-collect-garbage* nil)
106 (gc-on)
107 ;;
108 ;; Save the lisp.
109 (save-lisp output-file)))
110
111 (quit)

  ViewVC Help
Powered by ViewVC 1.1.5