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

Contents of /src/tools/config.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4.2.1 - (hide annotations)
Tue Jun 6 10:08:25 2000 UTC (13 years, 10 months ago) by dtc
Branch: RELENG_18
CVS Tags: RELEASE_18d, RELEASE_18c
Changes since 1.4: +20 -12 lines
Add the configuration option of loading the Gray Streams library.
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 dtc 1.4.2.1 "$Header: /tiger/var/lib/cvsroots/cmucl/src/tools/config.lisp,v 1.4.2.1 2000/06/06 10:08:25 dtc Exp $")
11 ram 1.1 ;;;
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 dtc 1.4.2.1 (load-gray-streams t)
22 ram 1.4 (load-clm t)
23 ram 1.1 (load-clx t)
24     (load-hemlock t)
25     (other ()))
26     (loop
27     (fresh-line)
28     (format t " 1: specify result file (currently ~S)~%"
29     (namestring output-file))
30 dtc 1.4.2.1 (format t " 2: toggle loading of the Gray Stream library, currently ~
31     ~:[dis~;en~]abled.~%"
32     load-gray-streams)
33     (format t " 3: toggle loading of the CLX X library, currently ~
34 wlott 1.2 ~:[dis~;en~]abled.~%"
35 ram 1.1 load-clx)
36 dtc 1.4.2.1 (format t " 4: toggle loading of Motif and the graphical debugger, ~
37 ram 1.4 currently ~:[dis~;en~]abled.~
38     ~:[~% (would force loading of CLX.)~;~]~%"
39     load-clm load-clx)
40 dtc 1.4.2.1 (format t " 5: toggle loading the Hemlock editor, currently ~
41 wlott 1.2 ~:[dis~;en~]abled.~
42     ~:[~% (would force loading of CLX.)~;~]~%"
43     load-hemlock load-clx)
44 dtc 1.4.2.1 (format t " 6: specify some site-specific file to load.~@
45 ram 1.1 ~@[ Current files:~%~{ ~S~%~}~]"
46     (mapcar #'namestring other))
47 dtc 1.4.2.1 (format t " 7: configure according to current options.~%")
48     (format t " 8: abort the configuration process.~%")
49 ram 1.1 (format t "~%Option number: ")
50     (force-output)
51     (flet ((file-prompt (prompt)
52     (format t prompt)
53     (force-output)
54     (pathname (string-trim " " (read-line)))))
55     (let ((res (ignore-errors (read-from-string (read-line)))))
56     (case res
57     (1
58     (setq output-file (file-prompt "Result core file name: ")))
59     (2
60 dtc 1.4.2.1 (setq load-gray-streams (not load-gray-streams)))
61     (3
62 ram 1.1 (unless (setq load-clx (not load-clx))
63     (setq load-hemlock nil)))
64 dtc 1.4.2.1 (4
65 ram 1.4 (when (setq load-clm (not load-clm))
66     (setq load-clx t)))
67 dtc 1.4.2.1 (5
68 ram 1.1 (when (setq load-hemlock (not load-hemlock))
69     (setq load-clx t)))
70 dtc 1.4.2.1 (6
71 ram 1.1 (setq other
72     (append other
73     (list (file-prompt "File(s) to load ~
74     (can have wildcards): ")))))
75 dtc 1.4.2.1 (7 (return))
76     (8
77 ram 1.1 (format t "~%Aborted.~%")
78     (return-from abort))))))
79    
80     (gc-off)
81 dtc 1.4.2.1 (when load-gray-streams
82     (load "library:subsystems/gray-streams-library"))
83 ram 1.1 (when load-clx
84 wlott 1.3 (setf *features* (delete :no-clx *features* :test #'eq))
85 ram 1.1 (load "library:subsystems/clx-library"))
86 ram 1.4 (when load-clm
87     (setf *features* (delete :no-clm *features* :test #'eq))
88     (load "library:subsystems/clm-library"))
89 ram 1.1 (when load-hemlock
90 wlott 1.3 (setf *features* (delete :no-hemlock *features* :test #'eq))
91 ram 1.1 (load "library:subsystems/hemlock-library"))
92     (dolist (f other) (load f))
93    
94     (setq *info-environment*
95     (list* (make-info-environment :name "Working")
96     (compact-info-environment (first *info-environment*)
97     :name "Auxiliary")
98     (rest *info-environment*)))
99    
100     (when (probe-file output-file)
101     (multiple-value-bind
102     (ignore old new)
103     (rename-file output-file
104     (concatenate 'string (namestring output-file)
105     ".BAK"))
106     (declare (ignore ignore))
107     (format t "~&Saved ~S as ~S.~%" (namestring old) (namestring new))))
108    
109     ;;
110     ;; Enable the garbage collector. But first fake it into thinking that
111     ;; we don't need to garbage collect. The save-lisp is going to call
112     ;; purify so any garbage will be collected then.
113     (setf lisp::*need-to-collect-garbage* nil)
114     (gc-on)
115     ;;
116     ;; Save the lisp.
117     (save-lisp output-file)))
118    
119     (quit)

  ViewVC Help
Powered by ViewVC 1.1.5