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

Contents of /src/tools/config.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Jan 14 02:23:50 1993 UTC (21 years, 3 months ago) by wlott
Branch: MAIN
Changes since 1.1: +7 -5 lines
Changed some messages to be less confusing.
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.2 1993/01/14 02:23:50 wlott 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-clx t)
22 (load-hemlock t)
23 (other ()))
24 (loop
25 (fresh-line)
26 (format t " 1: specify result file (currently ~S)~%"
27 (namestring output-file))
28 (format t " 2: toggle loading of the CLX X library, currently ~
29 ~:[dis~;en~]abled.~%"
30 load-clx)
31 (format t " 3: toggle loading the Hemlock editor, currently ~
32 ~:[dis~;en~]abled.~
33 ~:[~% (would force loading of CLX.)~;~]~%"
34 load-hemlock load-clx)
35 (format t " 4: specify some site-specific file to load.~@
36 ~@[ Current files:~%~{ ~S~%~}~]"
37 (mapcar #'namestring other))
38 (format t " 5: configure according to current options.~%")
39 (format t " 6: abort the configuration process.~%")
40 (format t "~%Option number: ")
41 (force-output)
42 (flet ((file-prompt (prompt)
43 (format t prompt)
44 (force-output)
45 (pathname (string-trim " " (read-line)))))
46 (let ((res (ignore-errors (read-from-string (read-line)))))
47 (case res
48 (1
49 (setq output-file (file-prompt "Result core file name: ")))
50 (2
51 (unless (setq load-clx (not load-clx))
52 (setq load-hemlock nil)))
53 (3
54 (when (setq load-hemlock (not load-hemlock))
55 (setq load-clx t)))
56 (4
57 (setq other
58 (append other
59 (list (file-prompt "File(s) to load ~
60 (can have wildcards): ")))))
61 (5 (return))
62 (6
63 (format t "~%Aborted.~%")
64 (return-from abort))))))
65
66 (gc-off)
67 (when load-clx
68 (load "library:subsystems/clx-library"))
69 (when load-hemlock
70 (load "library:subsystems/hemlock-library"))
71 (dolist (f other) (load f))
72
73 (setq *info-environment*
74 (list* (make-info-environment :name "Working")
75 (compact-info-environment (first *info-environment*)
76 :name "Auxiliary")
77 (rest *info-environment*)))
78
79 (when (probe-file output-file)
80 (multiple-value-bind
81 (ignore old new)
82 (rename-file output-file
83 (concatenate 'string (namestring output-file)
84 ".BAK"))
85 (declare (ignore ignore))
86 (format t "~&Saved ~S as ~S.~%" (namestring old) (namestring new))))
87
88 ;;
89 ;; Enable the garbage collector. But first fake it into thinking that
90 ;; we don't need to garbage collect. The save-lisp is going to call
91 ;; purify so any garbage will be collected then.
92 (setf lisp::*need-to-collect-garbage* nil)
93 (gc-on)
94 ;;
95 ;; Save the lisp.
96 (save-lisp output-file)))
97
98 (quit)

  ViewVC Help
Powered by ViewVC 1.1.5