1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 (%include e-macros)
18
19 (declare
20 (special bufed-goback-buf bufed-wopt bufed-kill-list known-buflist
21 two-window-mode))
22
23 (declare
24 (*expr buffer-kill create-new-window-and-stay-here delete-window
25 get-buffer-state go-to-hpos lruify-current-window lruify-window
26 save-same-file window-adjust-lower window-adjust-upper))
27
28 (defun edit-buffers ()(bufed))
29 (defun bufed ()
30 (prog (tbufnam origbuf origmark)
31 (setq origbuf current-buffer)
32 (setq tbufnam 'BUFEDIT)
33 (if numarg (find-buffer-in-window tbufnam)
34 else (go-to-or-create-buffer tbufnam))
35 (register-local-var 'bufed-goback-buf)
36 (setq bufed-goback-buf origbuf)
37 (register-local-var 'bufed-wopt)
38 (setq bufed-wopt numarg numarg nil)
39 (register-local-var 'bufed-kill-list)
40 (setq bufed-kill-list nil)
41 (bufedit-mode)
42 (go-to-beginning-of-buffer)
43 (setq read-only-flag nil)
44 (do ((bufl (delq tbufnam (subst nil nil known-buflist))
45 (cdr bufl))
46 (buf))
47 ((null bufl))
48 (setq buf (car bufl))
49 (or (line-is-blank)(without-saving (kill-to-end-of-line)))
50 (and (eq buf previous-buffer) (setq origmark (set-mark)))
51 (cond ((eq buf bufed-goback-buf)(insert-char ">"))
52 (t (insert-char SPACE)))
53 (cond ((get-buffer-state buf 'buffer-modified-flag)
54 (insert-char "*"))
55 (t (insert-char SPACE)))
56 (do-times 2 (insert-char SPACE))
57 (insert-string buf)
58 (cond ((get-buffer-state buf 'fpathname)
59 (format-to-col 25.)
60 (insert-string (get-buffer-state buf 'fpathname))))
61 (if (lastlinep)(new-line) else (next-line)))
62 (backward-char)
63 (without-saving (with-mark m (go-to-end-of-buffer)(wipe-point-mark m)))
64 (go-to-mark origmark)
65 (release-mark origmark)
66 (setq read-only-flag t buffer-modified-flag nil)
67 (select-buffer-window current-buffer 'cursize)))
68
69
70 (defun bufedit-mode ()
71 (if (empty-buffer-p current-buffer)
72 (setq current-buffer-mode 'Buffer/ Edit)
73 (mapc '(lambda (x)(set-key (car x)(cadr x)))
74 '(
75 (w edit-windows) (W edit-windows)
76 (q bufed-quit) (Q bufed-quit)
77 (e bufed-examine) (E bufed-examine)
78 (d bufed-kill) (D bufed-kill)
79 (k bufed-kill) (K bufed-kill)
80 (g bufed-go) (G bufed-go)
81 (u bufed-undelete) (U bufed-undelete)
82 (p bufed-prev) (P bufed-prev)
83 (n bufed-next) (N bufed-next)
84 (f bufed-find) (F bufed-find)
85 (s bufed-save) (S bufed-save)
86 (^X^Q bufed-quit)))))
87
88 (defun bufed-prev ()
89 (if (firstlinep)(go-to-end-of-buffer)
90 (go-to-beginning-of-line)
91 else (prev-line)))
92
93 (defun bufed-next ()
94 (if (lastlinep)(go-to-beginning-of-buffer) else (next-line)))
95
96 (defun bufed-validate-target (targ)
97 (if (memq targ bufed-kill-list)
98 (display-error "Buffer " targ " to be deleted. Can't go there."))
99 (if (not (memq targ known-buflist))
100 (display-error "Buffer " targ " no longer exists. Choose another.")))
101
102 (defun bufed-go ()
103 (let ((targ (bufed-get-bufnam))
104 (goback bufed-goback-buf))
105 (bufed-validate-target targ)
106 (bufed-check-deletions)
107 (set-buffer-self-destruct 'BUFEDIT)
108 (select-buffer-window targ nil)
109 (setq previous-buffer goback)))
110
111 (defun bufed-find ()
112 (let ((buf (bufed-get-bufnam))
113 (goback bufed-goback-buf))
114 (bufed-validate-target buf)
115 (bufed-check-deletions)
116 (set-buffer-self-destruct 'BUFEDIT)
117 (find-buffer-in-window buf)
118 (setq previous-buffer goback)))
119
120
121 (defun bufed-quit ()
122 (bufed-validate-target bufed-goback-buf)
123 (bufed-check-deletions)
124 (set-buffer-self-destruct 'BUFEDIT)
125 (if bufed-wopt
126 (lruify-current-window)
127 (find-buffer-in-window bufed-goback-buf)
128 else
129 (select-buffer-window bufed-goback-buf nil)))
130
131 (defun bufed-examine ()
132 (if two-window-mode
133 (let ((bub current-buffer)
134 (targ (bufed-get-bufnam)))
135 (let ((wf (buffer-on-display-in-window targ)))
136 (if wf
137 (display-error-remark
138 "Buffer " targ " on display in window "
139 (decimal-rep wf))
140 else
141 (find-buffer-in-window targ)
142 (setq wf (buffer-on-display-in-window targ))
143 (display-error-remark
144 "Buffer " targ " on display in window "
145 (decimal-rep wf))
146 (find-buffer-in-window bub)
147 (lruify-window wf))))
148 else
149 (go-to-buffer (bufed-get-bufnam))
150 (display-error-noabort "^XB CR to get back to Buffer Edit.")))
151
152 (defun bufed-kill ()
153 (go-to-hpos 2)
154 (if-at 'X (go-to-beginning-of-line)
155 else
156 (without-modifying (delete-char)
157 (insert-char 'X))
158 (setq bufed-kill-list (cons (bufed-get-bufnam) bufed-kill-list))
159 (if (lastlinep)(go-to-beginning-of-line)
160 else (next-line))))
161
162 (defun bufed-check-deletions ()
163 (if bufed-kill-list
164 (init-local-displays)
165 (mapc 'local-display-generator-nnl
166 '("Buffers to Kill:" "----------------" ""))
167 (mapc 'local-display-generator-nnl bufed-kill-list)
168 (end-local-displays)
169 (if (yesp "Go ahead and kill these buffers? ")
170 (mapc 'buffer-kill bufed-kill-list))
171 (setq bufed-kill-list nil)))
172
173 (defun bufed-undelete ()
174 (go-to-hpos 2)
175 (if-at 'X
176 (without-modifying (delete-char)
177 (insert-string " "))
178 (setq bufed-kill-list (delq (bufed-get-bufnam) bufed-kill-list))
179 (if (lastlinep)(go-to-beginning-of-line)
180 else (next-line))))
181
182 (defun bufed-get-bufnam ()
183 (go-to-hpos 4.)
184 (prog2 0
185 (make_atom
186 (with-mark b
187 (if (go-to-hpos 25.)
188 (if (forward-search-in-line ">")
189 (backward-char)
190 else
191 (go-to-end-of-line))
192 (skip-back-whitespace))
193 (point-mark-to-string b)))
194 (go-to-beginning-of-line)))
195
196 (defun bufed-save ()
197 (save-excursion-buffer
198 (go-to-buffer (bufed-get-bufnam))
199 (save-same-file))
200 (go-to-hpos 1)
201 (if-at '*
202 (without-modifying
203 (delete-char) (insert-char SPACE)))
204 (if (lastlinep) (go-to-beginning-of-line)
205 else (next-line)))
206
207
208
209
210
211
212 (declare (special selected-window nuwindows))
213 (defun edit-windows ()
214 (let ((ona numarg)(numarg nil))
215 (if ona (find-buffer-in-window 'WINDOWSTAT))
216 (wstat-edit))
217 (select-buffer-window current-buffer 'cursize))
218
219 (defun wstat-edit ()
220 (go-to-or-create-buffer 'WINDOWSTAT)
221 (wstat-mode)
222 (select-buffer-window
223 current-buffer
224 (if (buffer-on-display-in-window current-buffer)
225 nuwindows
226 else (1+ nuwindows)))
227 (wstat-create-display)
228
229 (lruify-current-window))
230
231 (defun wstat-create-display ()
232 (setq read-only-flag nil buffer-modified-flag t)
233 (go-to-beginning-of-buffer)
234 (do i 1 (1+ i)(> i nuwindows)
235 (without-saving (kill-to-end-of-line))
236 (insert-string (decimal-rep i))
237 (if (= i selected-window)(insert-string "*"))
238 (format-to-col 4)
239 (let ((info (window-info i)))
240 (insert-string (decimal-rep (cadr info)))
241 (format-to-col 10.)
242 (insert-string (decimal-rep (caar info)))
243 (format-to-col 15.)
244 (insert-string (decimal-rep (cdar info)))
245 (format-to-col 20.)
246 (insert-string (caddr info))
247 (format-to-col 40.)
248 (if (null (cadddr info))
249 (insert-string "<<EMPTY>>")
250 else
251 (insert-string
252 (substr (cadddr info) 1
253 (min 10. (1- (stringlength (cadddr info))))))))
254 (if (lastlinep)(new-line) else (next-line)))
255 (rubout-char)
256 (without-saving (with-mark m (go-to-end-of-buffer)(wipe-point-mark m)))
257 (setq buffer-modified-flag nil read-only-flag t)
258 (go-to-beginning-of-buffer))
259
260 (defun wstat-mode ()
261 (if (empty-buffer-p current-buffer)
262 (mapc '(lambda (x)(set-key (car x)(cadr x)))
263 '((b edit-buffers)
264 (c wstat-create-window)
265 (/3 wstat-create-window)
266 (g wstat-go-window)
267 (f wstat-go-window)
268 (^ wstat-push-up-top)
269 (v wstat-push-down-bottom)
270 (u wstat-pull-up-bottom)
271 (a wstat-pull-down-top)
272 (k wstat-kill-window)
273 (d wstat-kill-window)
274 (n wstat-next)
275 (p wstat-prev)))
276 (setq current-buffer-mode 'Window/ Edit)))
277
278 (defun wstat-create-window ()
279 (create-new-window-and-stay-here)
280 (wstat-create-display)
281 (go-to-end-of-buffer)
282 (go-to-beginning-of-line))
283
284 (defprop wstat-next t argwants)(defprop wstat-prev t argwants)
285 (defun wstat-next ()(if (lastlinep)(go-to-beginning-of-buffer)else (next-line)))
286 (defun wstat-prev ()(if (firstlinep)(go-to-end-of-buffer)(go-to-beginning-of-line)
287 else (prev-line)))
288
289 (defun wstat-go-window ()
290 (set-buffer-self-destruct 'WINDOWSTAT)
291 (select-window (wstat-collect-wnum)))
292
293 (defun wstat-kill-window ()
294 (delete-window (wstat-collect-wnum))
295 (save-excursion (wstat-create-display)))
296
297 (defun wstat-collect-wnum ()
298 (prog2 (go-to-beginning-of-line)
299 (let ((ibase 10.))
300 (readlist (explodec
301 (with-mark m (forward-word)
302 (point-mark-to-string m)))))
303 (go-to-beginning-of-line)))
304
305 (defun wstat-push-up-top ()
306 (let ((howmuch (or numarg 1))
307 (u (wstat-collect-wnum)))
308 (if (= u 1)(display-error "The top window has no topline!"))
309 (if (< (- (cdar (window-info (1- u))) howmuch) 3)
310 (display-error "Attempt to make upstairs window too small."))
311 (window-adjust-upper u (- howmuch)))
312 (save-excursion (wstat-create-display)))
313
314 (defun wstat-push-down-bottom ()
315 (let ((howmuch (or numarg 1))
316 (u (wstat-collect-wnum)))
317 (if (= u nuwindows)
318 (display-error "The bottom window has no bottomline!"))
319 (if (< (- (cdar (window-info (1+ u))) howmuch) 3)
320 (display-error "Attempt to make downstairs window too small."))
321 (window-adjust-lower u howmuch))
322 (save-excursion (wstat-create-display)))
323
324 (defun wstat-pull-down-top ()
325 (let ((howmuch (or numarg 1))
326 (u (wstat-collect-wnum)))
327 (if (= u 1)(display-error "The top window has no topline!"))
328 (if (< (- (cdar (window-info u)) howmuch) 3)
329 (display-error "Attempt to make this window too small."))
330 (window-adjust-upper u howmuch))
331 (save-excursion (wstat-create-display)))
332
333 (defun wstat-pull-up-bottom ()
334 (let ((howmuch (or numarg 1))
335 (u (wstat-collect-wnum)))
336 (if (= u nuwindows)
337 (display-error "The bottom window has no bottomline!"))
338 (if (< (- (cdar (window-info u)) howmuch) 3)
339 (display-error "Attempt to make this window too small."))
340 (window-adjust-lower u (- howmuch)))
341 (save-excursion (wstat-create-display)))