1 ;;; ***********************************************************
  2 ;;; *                                                         *
  3 ;;; * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4 ;;; *                                                         *
  5 ;;; * Copyright (c) 1978 by Massachusetts Institute of        *
  6 ;;; * Technology and Honeywell Information Systems, Inc.      *
  7 ;;; *                                                         *
  8 ;;; ***********************************************************
  9 ;;;
 10 ;;;
 11 ;;;       Bufed pro bufonibus.
 12 ;;;       BSG 4/14/79
 13 ;;; Modified: 4 December 1983 - B. Margolin - fix misspelling in
 14 ;;;           message printed by bufed-examine.
 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))           ;gonna get switched w bufs
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 ;;;^L
207 ;;;
208 ;;;       Window editor   BSG 4/14/79
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 ;       (redisplay)
229        (lruify-current-window))
230 
231 (defun wstat-create-display ()
232        (setq read-only-flag nil buffer-modified-flag t)     ;suppr modified msg
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)))   ;internal #
241            (format-to-col 10.)
242            (insert-string (decimal-rep (caar info)))   ;startline
243                 (format-to-col 15.)
244                 (insert-string (decimal-rep (cdar info)))   ;nlines
245                 (format-to-col 20.)
246                 (insert-string (caddr info))      ;buffer
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)))