1 & ***********************************************************
2 & * *
3 & * Copyright, C Honeywell Information Systems Inc., 1982 *
4 & * *
5 & ***********************************************************
6 &
7 & ******************************************************
8 & * *
9 & * *
10 & * Copyright c 1981 by Massachusetts Institute of *
11 & * Technology and Honeywell Information Systems, Inc. *
12 & * *
13 & * *
14 & ******************************************************
15 &
16 & Exec Com to dump the Emacs Lisp environments.
17 &
18 & Written: 6 May 1981 RMSoley from many old tries.
19 & Modified: 17 June 1981 RMSoley for Emacs reorganization.
20 & Modified: 22 June 1981 RMSoley to fix alternate-key-bindings.
21 & Modified: 1 July 1981 RMSoley to compile search list file.
22 & Modified: 8 July 1981 RMSoley to dump version-named save file.
23 & Modified: 13 August 1981 RMSoley for emacs/emacs_ compatibility.
24 & Modified: 5 November 1981 RMSoley for "both" argument.
25 & Modified: 8 November 1981 RMSoley for "no-break" initialization.
26 & Modified: 12 April 1982 RMSoley for new site-dir, get rid of tty-ctl-dir.
27 & Modified: 23 January 1984 Barmar for e_option_defaults_.
28 & Modified: 29 September 1984 Barmar to move e_self_documentor_ to regular Emacs.
29 &
30 & ARGUMENTS:
31 & This EC takes two arguments, the first of which must be "emacs" or "emacs_",
32 & specifying which kind of environment to dump. The second must be
33 & "unb", "exl", or "test", specifying which kind of exposure.
34 &
35 &command_line off
36 &input_line off
37 &
38 &if equal &n 2 &then &goto right_argno
39 &print Syntax: make_emacs <emacs | emacs_ | both> <exl | test | unb>
40 &quit
41 &
42 &label right_argno
43 &if equal &1 emacs &then &goto good_e_name
44 &if equal &1 emacs_ &then &goto good_e_name
45 &if equal &1 both &then &goto good_e_name
46 &print First argument must be "emacs", "emacs_", or "both".
47 &quit
48 &
49 &label good_e_name
50 &if equal &2 exl &then &goto good_name
51 &if equal &2 test &then &goto good_name
52 &if equal &2 unb &then &goto good_name
53 &print Second argument must be "exl", "test", or "unb".
54 &quit
55 &
56 &label good_name
57 &
58 & Recurse if &1=both.
59 &
60 &if not equal &1 both &then &goto not_both
61 &
62 exec_com &ec_dir>&ec_name emacs emacs_ &2
63 &quit
64 &
65 &
66 &label not_both
67 &
68 &attach
69 lisp
70 &
71 do in read read eq in 'applesauce '|| eval in
72 &
73 sstatus feature Emacs
74 setq NowDumpingEmacs t nobreak-functions
75 *array '*VIRGIN-OBARRAY* 'obarray t
76 &
77 &if not equal &2 exl &then &goto skip_exl
78 setq env-dir ">exl>emacs_dir>executable"
79 lisp-system-dir ">exl>lisp_dir>executable"
80 documentation-dir ">exl>emacs_dir>info"
81 site-dir ">exl>emacs_dir>executable"
82 include-dir ">exl>include"
83 &
84 &goto got_dirs
85 &label skip_exl
86 &if not equal &2 test &then &goto skip_test
87 setq env-dir ">exl>emacs_dir>Test_Emacs"
88 lisp-system-dir ">exl>lisp_dir>executable"
89 documentation-dir ">exl>emacs_dir>info"
90 site-dir ">exl>emacs_dir>executable"
91 include-dir ">exl>emacs_dir>include"
92 &
93 &goto got_dirs
94 &label skip_test
95 setq env-dir ">system_library_unbundled"
96 lisp-system-dir ">system_library_unbundled"
97 documentation-dir ">documentation>subsystem>emacs_dir"
98 site-dir ">system_library_unbundled"
99 include-dir ">library_dir_dir>include"
100 &
101 &label got_dirs
102 &
103 defun &loader& l
104 mapc 'lambda x
105 terpri
106 princ "Loading "
107 princ x
108 princ " ...."
109 load x
110 l
111 &
112 & Load in basic emacs.
113 &
114 &loader& 'e_defpl1_ e_lap_
115 e_interact_ e_multics_files_
116 e_binding_table_ e_option_defaults_
117 e_redisplay_ e_basic_
118 e_window_mgr_ e_listen_interface_
119 e_self_documentor_
120 &
121 & Fix up alternate-key-bindings.
122 &
123 do a 0 1+ a = a 2
124 do b 0 1+ b = b 128.
125 and eq key-bindings b a 'self-insert
126 store alternate-key-bindings b a 'self-insert
127 store alternate-key-bindings 33 0 'escape
128 &
129 & Load full emacs if dumping complete emacs.
130 &
131 &if equal &1 emacs_ &then &goto no_unb
132 &
133 &print
134 &print
135 &print Dumping full emacs.
136 &
137 &loader& 'e_macops_
138 &
139 &label no_unb
140 &
141 & Get current version number.
142 setq emacs-version e_lap_$rtrim emacs$get_version
143 &
144 & Check for experimental installation.
145 &
146 &if not equal &2 unb &then &goto exl_dump
147 &
148 &print
149 &print
150 &print Dumping standard emacs.
151 &
152 setq mode-line-herald catenate "Emacs " emacs-version
153 &
154 &goto join
155 &
156 &label exl_dump
157 &
158 &print
159 &print
160 &print Dumping experimental emacs.
161 &
162 setq mode-line-herald catenate "Emacs " emacs-version " EXL"
163 &
164 *rset t
165 sstatus uuolinks t
166 &
167 &label join
168 &
169 &if equal &2 unb &then &goto no_carry
170 & For the sake of Carry, create saved environment segment
171 &
172 cline catenate "if not exists entry &1." emacs-version ".sv.lisp"
173 " -then ""create &1." emacs-version ".sv.lisp"""
174 &
175 &label no_carry
176 &
177 setplist '&loader&
178 remob '&loader&
179 &
180 setq errlist cons 'hcs_$initiate_count env-dir 'e_pl1_ 'e_pl1_ 0
181 errlist ;fix supdup output bug.
182 setq NowDumpingEmacs nil
183 gctwa
184 gc
185 sstatus gctime 0
186 &
187 applesauce
188 &
189 eval list 'save catenate "&1." emacs-version
190 &detach
191 &print
192 &print Finished.
193 &quit