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

Contents of /src/tools/config.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5