|
0
|
1 ;;; -*- Mode:Emacs-Lisp -*-
|
|
|
2 ;;; Copyright © 1992 by Lucid, Inc. All Rights Reserved.
|
|
|
3
|
|
|
4 ;;; Displaying buffers. Why is this so hard?
|
|
|
5
|
|
|
6
|
|
|
7 ;;; This crud is damage control, because sometimes things get confused, and
|
|
|
8 ;;; the server asks us to display a buffer that has been killed.
|
|
|
9
|
|
|
10 (defun energize-request-kill-buffer-if-dead (buffer)
|
|
|
11 (cond ((not (bufferp buffer)) t)
|
|
|
12 ((null (buffer-name buffer))
|
|
|
13 (if (energize-buffer-p buffer)
|
|
|
14 (energize-request-kill-buffer buffer))
|
|
|
15 t)
|
|
|
16 (t nil)))
|
|
|
17
|
|
|
18 (defun energize-prune-killed-buffers-from-list (buffer-extent-list)
|
|
|
19 (let ((rest buffer-extent-list)
|
|
|
20 (buffer-count 0)
|
|
|
21 (deleted-count 0))
|
|
|
22 (while rest
|
|
|
23 (let* ((buffer (car rest))
|
|
|
24 (extent (car (cdr rest))))
|
|
|
25 (setq rest (cdr (cdr rest)))
|
|
|
26 (setq buffer-count (1+ buffer-count))
|
|
|
27 (if (energize-request-kill-buffer-if-dead buffer)
|
|
|
28 (progn
|
|
|
29 (setq deleted-count (1+ deleted-count))
|
|
|
30 (setq buffer-extent-list (delq buffer buffer-extent-list))
|
|
|
31 (setq buffer-extent-list (delq extent buffer-extent-list))))))
|
|
|
32 (if (> deleted-count 0)
|
|
|
33 (progn
|
|
|
34 (message
|
|
|
35 (format "Oops, confused about %s selected %s -- please try again."
|
|
|
36 (if (> deleted-count 1)
|
|
|
37 (format "%d of the" deleted-count)
|
|
|
38 (if (> buffer-count 1)
|
|
|
39 "one of the"
|
|
|
40 "the"))
|
|
|
41 (if (> buffer-count 1)
|
|
|
42 "buffers"
|
|
|
43 "buffer")))
|
|
|
44 (ding t)))
|
|
|
45 buffer-extent-list))
|
|
|
46
|
|
|
47
|
|
|
48 (defvar energize-auto-scroll-p t ;#### this should be nil, t is LOSING
|
|
|
49 "*If t, energize will scroll your debugger and error log buffers
|
|
|
50 to the bottom whenever output appears with reckless abandon. If nil,
|
|
|
51 it will behave just like normal shell and gdb-mode buffers.")
|
|
|
52
|
|
|
53 (defvar energize-error-log-context-lines 0
|
|
|
54 "*Number of lines to skip above the current error in the Energize error log")
|
|
|
55
|
|
|
56 ;;; called by energize-show-all-buffers
|
|
|
57 ;;; If the extent is specified:
|
|
|
58 ;;; - scrolls the window so that point is at at the beginning of the extent.
|
|
|
59 ;;; - If the buffer is "Error Log", the extent is moved to top-of-window.
|
|
|
60 ;;; - if `only-one' and the buffer is a source buffer, then... what?
|
|
|
61 ;;; If the buffer is "*Debugger*" or "Error Log", point is moved to eof,
|
|
|
62 ;;; IF and ONLY if it was at EOF already.
|
|
|
63 ;;;
|
|
|
64 (defun energize-scroll-window-at-extent (window extent only-one)
|
|
|
65 (let* ((buffer (window-buffer window))
|
|
|
66 (type (energize-buffer-type buffer)))
|
|
|
67 (if (and extent (null (extent-start-position extent)))
|
|
|
68 ;; it has been detached somehow.
|
|
|
69 (setq extent nil))
|
|
|
70 (if extent
|
|
|
71 (let ((pos (extent-start-position extent)))
|
|
|
72 (if (not (eq pos 0))
|
|
|
73 (progn
|
|
|
74 (set-window-point window pos)
|
|
|
75 (cond ((eq type 'energize-error-log-buffer)
|
|
|
76 ;; scroll the Error Log buffer so that the first error
|
|
|
77 ;; is at the top of the window.
|
|
|
78 (set-window-start window
|
|
|
79 (save-excursion
|
|
|
80 (set-buffer buffer)
|
|
|
81 (goto-char pos)
|
|
|
82 (forward-line
|
|
|
83 (-
|
|
|
84 energize-error-log-context-lines))
|
|
|
85 (beginning-of-line)
|
|
|
86 (point))))
|
|
|
87 ((and only-one (eq type 'energize-source-buffer))
|
|
|
88 ;; if only one buffer is requested to be visible and it
|
|
|
89 ;; is a source buffer then scroll point close to the top
|
|
|
90 (set-window-start window
|
|
|
91 (save-excursion
|
|
|
92 (set-buffer buffer)
|
|
|
93 (goto-char pos)
|
|
|
94 (beginning-of-line)
|
|
|
95 (if (> (window-height window)
|
|
|
96 next-screen-context-lines)
|
|
|
97 (vertical-motion
|
|
|
98 (- next-screen-context-lines)
|
|
|
99 window)
|
|
|
100 (vertical-motion -1 window))
|
|
|
101 (point)))))))))
|
|
|
102
|
|
|
103 (cond ((and (memq type '(energize-error-log-buffer
|
|
|
104 energize-debugger-buffer))
|
|
|
105 ; don't move point if it's before the last line
|
|
|
106 (or energize-auto-scroll-p
|
|
|
107 (>= (window-point window)
|
|
|
108 (save-excursion
|
|
|
109 (set-buffer (window-buffer window))
|
|
|
110 ;;(comint-mark)
|
|
|
111 (energize-user-input-buffer-mark)
|
|
|
112 )))
|
|
|
113 )
|
|
|
114 ;; Debugger and Error Log buffers generally get scrolled to
|
|
|
115 ;; the bottom when displayed.
|
|
|
116 (set-window-point window
|
|
|
117 (save-excursion (set-buffer buffer)
|
|
|
118 (+ 1 (buffer-size))))
|
|
|
119 ;; Careful to deactivate the selection when automatically moving
|
|
|
120 ;; the user to the end of the buffer. This is suboptimal, but
|
|
|
121 ;; otherwise we have bad interactions with the debugger-panel
|
|
|
122 ;; Print button. (Double-click on a value (point is now at the
|
|
|
123 ;; end of that word); hit Print; point is now at point-max, but
|
|
|
124 ;; the original word is still highlighted, which is incorrect -
|
|
|
125 ;; we're now in a state where the selection highlighting and the
|
|
|
126 ;; region between point and mark is out of sync. I'm not entirely
|
|
|
127 ;; sure how to fix this short of using a point-motion hook of some
|
|
|
128 ;; kind, so we'll punt, and just deactivate the region instead.)
|
|
|
129 (zmacs-deactivate-region)
|
|
|
130 ))))
|
|
|
131
|
|
|
132
|
|
|
133 ;;; called by energize-make-buffers-visible
|
|
|
134 ;;; For each of the contents of an plist of buffers and extents:
|
|
|
135 ;;; - If the buffer is visible in a window
|
|
|
136 ;;; - dedicate the window
|
|
|
137 ;;; - energize-scroll-window-at-extent
|
|
|
138 ;;; If we dedicated any windows, select the last one dedicated.
|
|
|
139 ;;; For each of the buffers and extents:
|
|
|
140 ;;; - pop-to-buffer
|
|
|
141 ;;; - remember the first window selected in this way
|
|
|
142 ;;; - dedicate the window
|
|
|
143 ;;; - energize-scroll-window-at-extent; only-one arg is true if there
|
|
|
144 ;;; is only one buffer/extent pair in the list
|
|
|
145 ;;; - if energize-edit-buffer-externally-p make it read-only
|
|
|
146 ;;; Un-dedicate the windows
|
|
|
147 ;;; Select the remembered window (the first one we popped-to-buffer on)
|
|
|
148 ;;; Maybe raise its frame
|
|
|
149 ;;;
|
|
|
150 (defun energize-show-all-buffers (buffer-extent-list)
|
|
|
151 (let ((pop-up-windows t)
|
|
|
152 (dedicated-windows ())
|
|
|
153 (buffer-extent-current)
|
|
|
154 (window-to-select ())
|
|
|
155 (only-one (null (cdr (cdr buffer-extent-list)))))
|
|
|
156 (setq buffer-extent-current buffer-extent-list)
|
|
|
157 (while buffer-extent-current
|
|
|
158 (let* ((buffer (car buffer-extent-current))
|
|
|
159 (extent (car (cdr buffer-extent-current)))
|
|
|
160 (window (get-buffer-window buffer (selected-frame))))
|
|
|
161 (if window
|
|
|
162 (progn
|
|
|
163 (set-window-buffer-dedicated window buffer)
|
|
|
164 (setq dedicated-windows (cons window dedicated-windows))
|
|
|
165 (energize-scroll-window-at-extent window extent only-one)))
|
|
|
166 (setq buffer-extent-current (cdr (cdr buffer-extent-current)))))
|
|
|
167 (if dedicated-windows
|
|
|
168 (select-window (car dedicated-windows)))
|
|
|
169 (setq buffer-extent-current buffer-extent-list)
|
|
|
170 (while buffer-extent-current
|
|
|
171 (let* ((buffer (car buffer-extent-current))
|
|
|
172 (extent (car (cdr buffer-extent-current))))
|
|
|
173 ;; ## what was this intended to do? a frame is being passed as the
|
|
|
174 ;; ## argument which means "always select a different window even if
|
|
|
175 ;; ## it's visible in the selected window.
|
|
|
176 ;; (pop-to-buffer buffer nil (selected-frame))
|
|
|
177 (pop-to-buffer buffer)
|
|
|
178 (if (energize-edit-buffer-externally-p buffer)
|
|
|
179 (setq buffer-read-only t))
|
|
|
180 (let ((window (selected-window)))
|
|
|
181 (if (null window-to-select)
|
|
|
182 (setq window-to-select window))
|
|
|
183 (set-window-buffer-dedicated window buffer)
|
|
|
184 (setq dedicated-windows (cons window dedicated-windows))
|
|
|
185 (energize-scroll-window-at-extent window extent only-one))
|
|
|
186 (setq buffer-extent-current (cdr (cdr buffer-extent-current)))))
|
|
|
187 (while dedicated-windows
|
|
|
188 (set-window-buffer-dedicated (car dedicated-windows) ())
|
|
|
189 (setq dedicated-windows (cdr dedicated-windows)))
|
|
|
190
|
|
|
191 (select-window window-to-select)
|
|
|
192 ;; now we may have to pop the frame up
|
|
|
193 (let ((frame (selected-frame)))
|
|
|
194 (if (and energize-auto-raise-screen
|
|
|
195 (or (not (frame-visible-p frame))
|
|
|
196 (not (frame-totally-visible-p frame))))
|
|
|
197 (progn
|
|
|
198 (sit-for 0)
|
|
|
199 (make-frame-visible frame))))))
|
|
|
200
|
|
|
201 ;;; called by energize-make-buffers-visible
|
|
|
202 (defun energize-main-buffer-of-list (list)
|
|
|
203 ;; Given an alternating list of buffers and extents, pick out the
|
|
|
204 ;; "interesting" buffer. If one of the buffers is in debugger-mode,
|
|
|
205 ;; or in breakpoint-mode, then that's the interesting one; otherwise,
|
|
|
206 ;; the last buffer in the list is the interesting one.
|
|
|
207 (let (buffer mode result)
|
|
|
208 (while list
|
|
|
209 (setq buffer (car list))
|
|
|
210 (or (memq mode '(energize-debugger-mode energize-breakpoint-mode))
|
|
|
211 (setq result buffer
|
|
|
212 mode (save-excursion (set-buffer buffer) major-mode)))
|
|
|
213 (setq list (cdr (cdr list))))
|
|
|
214 result))
|
|
|
215
|
|
|
216 ;;; called by energize-make-many-buffers-visible-function
|
|
|
217 ;;; If there is only one buffer/extent pair, and it's a source buffer, then
|
|
|
218 ;;; edit it in vi if that's the kind of kinkiness we're into.
|
|
|
219 ;;; Get the "main" buffer, and select a frame for it.
|
|
|
220 ;;; Then call energize-show-all-buffers.
|
|
|
221 ;;;
|
|
|
222 (defun energize-make-buffers-visible (buffer-extent-list)
|
|
|
223 (let ((main-buffer (energize-main-buffer-of-list buffer-extent-list))
|
|
|
224 window)
|
|
|
225 (if (and (null (cdr (cdr buffer-extent-list)))
|
|
|
226 (energize-edit-buffer-externally-p main-buffer))
|
|
|
227 (energize-edit-buffer-externally-1 main-buffer
|
|
|
228 (car (cdr buffer-extent-list)))
|
|
|
229 ;; This may create and/or select a frame as a side-effect.
|
|
|
230 ;; I'm not sure it's necessary to call this, as display-buffer
|
|
|
231 ;; calls it too. But it can't hurt to select the appropriate
|
|
|
232 ;; frame early...
|
|
|
233 (let ((hacked-frame nil))
|
|
|
234 (cond ((null energize-split-screens-p)
|
|
|
235 nil)
|
|
|
236 ((get-frame-name-for-buffer main-buffer)
|
|
|
237 (setq hacked-frame t)
|
|
|
238 (if pre-display-buffer-function
|
|
|
239 (funcall pre-display-buffer-function main-buffer nil nil))
|
|
|
240 )
|
|
|
241 ((setq window (get-buffer-window main-buffer t))
|
|
|
242 (cond (window
|
|
|
243 (setq hacked-frame t)
|
|
|
244 (select-frame (window-frame window))))))
|
|
|
245 (let ((pre-display-buffer-function
|
|
|
246 (if hacked-frame nil pre-display-buffer-function)))
|
|
|
247 (energize-show-all-buffers buffer-extent-list))
|
|
|
248 ;; ;; kludge!! Select the debugger frame, not the sources frame.
|
|
|
249 ;; (if (and (null energize-split-screens-p)
|
|
|
250 ;; pre-display-buffer-function)
|
|
|
251 ;; (funcall pre-display-buffer-function main-buffer nil nil))
|
|
|
252 ))))
|
|
|
253
|
|
|
254 ;;; this is the guts of energize-make-many-buffers-visible
|
|
|
255 ;;; `arg' is really two args: `buffer-extent-list' and `go-there'.
|
|
|
256 ;;; go-there is specified by
|
|
|
257 ;;; Given a list of buffer/extent pairs, make them all visible at once
|
|
|
258 ;;; (presumably in the same frame?)
|
|
|
259 ;;; If `go-there'
|
|
|
260 ;;; - call energize-make-buffers-visible
|
|
|
261 ;;; else
|
|
|
262 ;;; - dedicate the selected window
|
|
|
263 ;;; - call energize-make-buffers-visible
|
|
|
264 ;;; - re-select and undedicate the original selected window
|
|
|
265 ;;;
|
|
|
266 (defun energize-make-many-buffers-visible-function (arg)
|
|
|
267 (let ((buffer-extent-list (car arg))
|
|
|
268 (go-there (cdr arg)))
|
|
|
269 ;; enqueue an history record if we're going to move
|
|
|
270 (if go-there
|
|
|
271 (energize-history-enqueue))
|
|
|
272 (setq buffer-extent-list
|
|
|
273 (energize-prune-killed-buffers-from-list buffer-extent-list))
|
|
|
274 (if buffer-extent-list
|
|
|
275 (if go-there
|
|
|
276 (energize-make-buffers-visible buffer-extent-list)
|
|
|
277 (let ((window (selected-window)))
|
|
|
278 (set-window-buffer-dedicated window (window-buffer window))
|
|
|
279 (unwind-protect
|
|
|
280 (energize-make-buffers-visible buffer-extent-list)
|
|
|
281 (set-window-buffer-dedicated window ())
|
|
|
282 (select-window window)))))))
|
|
|
283
|
|
|
284 (defvar energize-make-many-buffers-visible-should-enqueue-event t
|
|
|
285 "Special variable bound by energize-execute-command to allow the
|
|
|
286 buffers to be selected while the command is executed")
|
|
|
287
|
|
|
288 ;;; called by by editorside.c:MakeBufferAndExtentVisible().
|
|
|
289 ;;; should-enqueue is bound by `energize-execute-command'
|
|
|
290 ;;;
|
|
|
291 (defun energize-make-many-buffers-visible (buffer-extent-list go-there)
|
|
|
292 "First arg is a list of buffers and extents. All those should be
|
|
|
293 made visible at the same time. If the second argument is T then point
|
|
|
294 should be moved to the first character of the extent of the first
|
|
|
295 buffer, or to the buffer if no extent is specified for this buffer.
|
|
|
296 If second argument is NIL point should not change."
|
|
|
297 (if energize-make-many-buffers-visible-should-enqueue-event
|
|
|
298 ;; don't do it from process filters, but wait until we come back to
|
|
|
299 ;; top-level. Using go-there should still be done sparingly, as we can
|
|
|
300 ;; surprise the user and grab their keystrokes into another buffer.
|
|
|
301 (enqueue-eval-event 'energize-make-many-buffers-visible-function
|
|
|
302 (cons buffer-extent-list go-there))
|
|
|
303 ;; go-there is always true when called from energize-execute-command,
|
|
|
304 ;; I guess under the assumption that it's always ok to select a buffer
|
|
|
305 ;; when we're doing something in direct response to a menu selection.
|
|
|
306 (energize-make-many-buffers-visible-function
|
|
|
307 (cons buffer-extent-list t))))
|
|
|
308
|
|
|
309
|
|
|
310 ;;; This deales with the energize history
|
|
|
311 (defvar energize-navigation-history '(nil)
|
|
|
312 "List of places where Energize took you to.
|
|
|
313 It is a list of (file-name/buffer-name . position)")
|
|
|
314
|
|
|
315 (defvar energize-history-maximum-length 20
|
|
|
316 "Maximum number of locations kept in the energize history")
|
|
|
317
|
|
|
318 (defvar energize-navigation-current ()
|
|
|
319 "Current pointer into the energize-navigation-history")
|
|
|
320
|
|
|
321 (defvar energize-navigation-current-length 0)
|
|
|
322
|
|
|
323 (defun energize-history-enqueue ()
|
|
|
324 "Memorize the current place in the history.
|
|
|
325 Trim the history if need be."
|
|
|
326 (let ((new-item
|
|
|
327 (cons (or buffer-file-truename (current-buffer))
|
|
|
328 (1+ (count-lines 1 (point))))))
|
|
|
329 (if (not (equal new-item (car energize-navigation-history)))
|
|
|
330 (progn
|
|
|
331 (setq energize-navigation-history
|
|
|
332 (cons new-item energize-navigation-history))
|
|
|
333 (setq energize-navigation-current-length
|
|
|
334 (1+ energize-navigation-current-length))
|
|
|
335 (if (> energize-navigation-current-length
|
|
|
336 (* 2 energize-history-maximum-length))
|
|
|
337 (let ((tail (nthcdr energize-history-maximum-length
|
|
|
338 energize-navigation-history)))
|
|
|
339 (rplacd tail nil)
|
|
|
340 (setq energize-navigation-current-length
|
|
|
341 energize-history-maximum-length)))))))
|
|
|
342
|
|
|
343 (defun energize-history-dequeue ()
|
|
|
344 "Forget the current place in the history"
|
|
|
345 (setq energize-navigation-history (cdr energize-navigation-history)))
|
|
|
346
|
|
|
347 (defun energize-history-go-back (item)
|
|
|
348 "Go back to the place memorized by item"
|
|
|
349 (let ((buffer-or-file (car item))
|
|
|
350 (position (cdr item))
|
|
|
351 (buffer ()))
|
|
|
352 (cond ((bufferp buffer-or-file)
|
|
|
353 (setq buffer buffer-or-file))
|
|
|
354 ((stringp buffer-or-file)
|
|
|
355 (setq buffer (or (get-file-buffer buffer-or-file)
|
|
|
356 (find-file-noselect buffer-or-file)))))
|
|
|
357 (if (null (buffer-name buffer))
|
|
|
358 ()
|
|
|
359 (pop-to-buffer buffer)
|
|
|
360 (goto-line position)
|
|
|
361 t)))
|
|
|
362
|
|
|
363 (defun energize-history-previous ()
|
|
|
364 "Go back in the history.
|
|
|
365 If the last command was the same go back more"
|
|
|
366 (interactive)
|
|
|
367 (if (not (eq last-command 'energize-history-previous))
|
|
|
368 (setq energize-navigation-current energize-navigation-history))
|
|
|
369 (energize-history-enqueue)
|
|
|
370 (while (and (car energize-navigation-current)
|
|
|
371 (not
|
|
|
372 (energize-history-go-back (car energize-navigation-current))))
|
|
|
373 (rplaca energize-navigation-current
|
|
|
374 (car (cdr energize-navigation-current)))
|
|
|
375 (rplacd energize-navigation-current
|
|
|
376 (cdr (cdr energize-navigation-current))))
|
|
|
377 (if (null (car energize-navigation-current))
|
|
|
378 (progn
|
|
|
379 (energize-history-dequeue)
|
|
|
380 (setq last-command 'beep)
|
|
|
381 (error "You reached the beginning of the Energize history"))
|
|
|
382 (setq energize-navigation-current
|
|
|
383 (cdr energize-navigation-current))))
|
|
|
384
|
|
|
385 (define-key global-map '(shift f14) 'energize-history-previous)
|
|
|
386
|
|
|
387 (defun energize-history ()
|
|
|
388 "Show the energize history in the energize history buffer"
|
|
|
389 (interactive)
|
|
|
390 (pop-to-buffer "*Energize History*")
|
|
|
391 (erase-buffer)
|
|
|
392 (mapcar (function (lambda (item)
|
|
|
393 (if item
|
|
|
394 (progn
|
|
|
395 (insert (format "%s" (car item)))
|
|
|
396 (indent-to-column 32 1)
|
|
|
397 (insert (format "%s\n" (cdr item)))))))
|
|
|
398 energize-navigation-history)
|
|
|
399 (goto-char (point-min))
|
|
|
400 (energize-history-mode))
|
|
|
401
|
|
|
402 (defun energize-history-mode ()
|
|
|
403 "Turn on energize history mode"
|
|
|
404 )
|
