0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
2
|
|
3 ;;; ilisp-out.el --
|
|
4
|
|
5 ;;; This file is part of ILISP.
|
4
|
6 ;;; Version: 5.8
|
0
|
7 ;;;
|
|
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
|
|
9 ;;; 1993, 1994 Ivan Vasquez
|
4
|
10 ;;; 1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
|
|
11 ;;; 1996 Marco Antoniotti and Rick Campbell
|
0
|
12 ;;;
|
|
13 ;;; Other authors' names for which this Copyright notice also holds
|
|
14 ;;; may appear later in this file.
|
|
15 ;;;
|
4
|
16 ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
|
|
17 ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
|
0
|
18 ;;; mailing list were bugs and improvements are discussed.
|
|
19 ;;;
|
|
20 ;;; ILISP is freely redistributable under the terms found in the file
|
|
21 ;;; COPYING.
|
|
22
|
|
23
|
|
24
|
|
25 ;;;
|
|
26 ;;; ILISP output, including a popper replacement.
|
|
27 ;;;
|
|
28
|
|
29 (defvar ilisp-output-buffer " *Output*")
|
|
30 (defvar ilisp-output-buffer-major-mode 'lisp-mode
|
|
31 "*The major mode for the ilisp typeout window.")
|
|
32 (defvar ilisp-output-min-height 2
|
|
33 "*The minimum height of the typeout window used to display ilisp output.")
|
|
34 (defvar ilisp-output-max-height 25
|
|
35 "*The maximum height of the typeout window used to display ilisp output.")
|
|
36 (defvar ilisp-display-output-function 'ilisp-display-output-default
|
|
37 "The name of a function to display all ilisp output. The function gets a
|
|
38 single argument, a string.")
|
|
39
|
|
40
|
|
41 ;; Minor mode (just to get a pretty mode line).
|
|
42 (defvar ilisp-output-mode-line nil)
|
|
43 (defvar ilisp-output-mode nil "If T, then we are in the ilisp-output minor mode.")
|
|
44 (make-variable-buffer-local 'ilisp-output-mode)
|
|
45
|
|
46 (or (assq 'ilisp-output-mode minor-mode-alist)
|
|
47 (setq minor-mode-alist
|
|
48 (cons '(ilisp-output-mode ilisp-output-mode-line) minor-mode-alist)))
|
|
49
|
|
50
|
|
51 (defun ilisp-output-buffer (&optional create-p)
|
|
52 (let ((buffer (if create-p
|
|
53 (get-buffer-create ilisp-output-buffer)
|
|
54 (get-buffer ilisp-output-buffer))))
|
|
55 (or ilisp-output-mode-line
|
|
56 (setq ilisp-output-mode-line
|
|
57 (list (format
|
|
58 " %s bury, %s scroll"
|
|
59 (ilisp-where-is 'ilisp-bury-output)
|
|
60 (ilisp-where-is 'ilisp-scroll-output)))))
|
|
61 buffer))
|
|
62
|
|
63 (defun ilisp-output-window ()
|
|
64 (let ((buffer (get-buffer ilisp-output-buffer)))
|
|
65 (if buffer
|
|
66 (get-buffer-window buffer))))
|
|
67
|
|
68
|
|
69 (defun lisp-display-output (output)
|
|
70 "Display OUTPUT in the appropriate place.
|
|
71 This calls the function given by the value of ilisp-display-output-function in
|
|
72 order to do the real work."
|
|
73 (cond ((null output))
|
|
74 (t
|
|
75 ;; Bugcheck
|
|
76 (if (not (stringp output))
|
|
77 (error "bug: not a string in lisp-display-output"))
|
|
78
|
|
79 (if (ilisp-value 'comint-errorp t)
|
|
80 (setq output (funcall (ilisp-value 'ilisp-error-filter)
|
|
81 output)))
|
|
82 (funcall ilisp-display-output-function output))))
|
|
83
|
|
84
|
|
85
|
|
86 ;;; Popper replacement
|
|
87
|
|
88
|
|
89 (defun ilisp-bury-output ()
|
|
90 "Delete the typeout window, if any"
|
|
91 (interactive)
|
|
92 (let* ((buffer (ilisp-output-buffer))
|
|
93 (window (and buffer (get-buffer-window buffer))))
|
|
94 (if buffer
|
|
95 (bury-buffer buffer))
|
|
96 (if window
|
|
97 (ilisp-delete-window window))))
|
|
98
|
|
99
|
|
100 (defun ilisp-show-output (&optional buffer)
|
|
101 "Make typeout visible, if it is not already."
|
|
102 (interactive)
|
|
103 (let ((buffer (or buffer (ilisp-output-buffer))))
|
|
104 (if buffer
|
|
105 (ilisp-display-buffer-in-typeout-window buffer))))
|
|
106
|
|
107
|
|
108 (defun ilisp-delete-window (window)
|
|
109 "Delete a window with minimal redisplay."
|
|
110 (let ((height (window-height window))
|
|
111 (lower-window (ilisp-find-lower-window window)))
|
|
112 (delete-window window)
|
|
113 (if (and lower-window
|
|
114 (not (eq lower-window window)))
|
|
115 (let ((old-window (selected-window)))
|
|
116 (save-excursion
|
|
117 (select-window lower-window)
|
|
118 (set-buffer (window-buffer))
|
|
119 (goto-char (window-start))
|
|
120 (vertical-motion (- height))
|
|
121 (set-window-start lower-window (point)))
|
|
122 (select-window old-window)))))
|
|
123
|
|
124
|
|
125 (defun ilisp-scroll-output (&optional lines)
|
|
126 "Scroll the typeout-window, if any."
|
|
127 (interactive "P")
|
|
128 (let* ((buffer (ilisp-output-buffer))
|
|
129 (window (and buffer (get-buffer-window buffer)))
|
|
130 (old-window (selected-window)))
|
|
131 (if window
|
|
132 (unwind-protect
|
|
133 (progn
|
|
134 (select-window window)
|
|
135 (set-buffer buffer)
|
191
|
136 ;; it won't hurt to bind this regardless of
|
|
137 ;; whether or not `scroll-in-place' is loaded.
|
|
138 (let ((scroll-in-place nil))
|
|
139 (scroll-up lines)))
|
0
|
140 (select-window old-window)))))
|
|
141
|
|
142
|
|
143 (defun ilisp-grow-output (&optional n)
|
|
144 "Grow the typeout window by ARG (default 1) lines."
|
|
145 (interactive "p")
|
|
146 (let* ((buffer (ilisp-output-buffer))
|
|
147 (window (and buffer (get-buffer-window buffer)))
|
|
148 (old-window (selected-window)))
|
|
149 (if window
|
|
150 (unwind-protect
|
|
151 (progn
|
|
152 (select-window window)
|
|
153 (enlarge-window n))
|
|
154 (if (ilisp-window-live-p old-window)
|
|
155 (select-window old-window))))))
|
|
156
|
|
157
|
|
158 (defun ilisp-trim-blank-lines ()
|
|
159 ;; Delete leading blank lines
|
|
160 (goto-char (point-min))
|
|
161 (if (looking-at "\n+")
|
|
162 (replace-match ""))
|
|
163 ;; Delete trailing blank lines
|
|
164 (goto-char (point-max))
|
|
165 (skip-chars-backward "\n")
|
|
166 (if (< (point) (point-max))
|
|
167 (delete-region (1+ (point)) (point-max))))
|
|
168
|
|
169
|
|
170 (defun ilisp-write-string-to-buffer (buffer string)
|
|
171 (save-excursion
|
|
172 (set-buffer buffer)
|
|
173 ;; Maybe an option to keep the old output?
|
|
174 (erase-buffer)
|
|
175 ;; New: select mode for the output buffer.
|
|
176 (if (not (eq major-mode ilisp-output-buffer-major-mode))
|
|
177 (funcall ilisp-output-buffer-major-mode))
|
|
178 (setq ilisp-output-mode t)
|
|
179 (princ string buffer)
|
|
180 (ilisp-trim-blank-lines)
|
|
181 (goto-char (point-min))))
|
|
182
|
|
183
|
|
184 (defun ilisp-desired-height (buffer-or-window)
|
|
185 (let ((height
|
|
186 (cond ((bufferp buffer-or-window)
|
|
187 (ilisp-needed-buffer-height buffer-or-window))
|
|
188 ((windowp buffer-or-window)
|
|
189 (ilisp-needed-window-height buffer-or-window)))))
|
|
190 (max window-min-height
|
|
191 (min ilisp-output-max-height
|
|
192 (max ilisp-output-min-height
|
|
193 height)))))
|
|
194
|
|
195
|
|
196 ;; A first guess at the height needed to display this buffer.
|
|
197 (defun ilisp-needed-buffer-height (buffer)
|
|
198 (save-excursion
|
|
199 (set-buffer buffer)
|
|
200 (1+ (count-lines (point-min) (point-max)))))
|
|
201
|
|
202
|
|
203 ;; The height this window must be to display its entire buffer.
|
|
204 (defun ilisp-needed-window-height (window)
|
|
205 (save-window-excursion
|
|
206 (select-window window)
|
|
207 (save-excursion
|
|
208 (set-buffer (window-buffer))
|
191
|
209 (+ 3 (save-excursion
|
0
|
210 (goto-char (point-min))
|
|
211 ;; Any upper bound on the height of an emacs window will
|
|
212 ;; do here. How about 1000.
|
|
213 (vertical-motion 1000))))))
|
|
214
|
|
215
|
|
216 (defun ilisp-shrink-wrap-window (window)
|
|
217 (let ((previously-selected-window (selected-window))
|
|
218 (buffer (window-buffer window)))
|
|
219
|
|
220 (select-window window)
|
|
221 (let* ((current-height (window-height window))
|
|
222 (desired-height (ilisp-desired-height window))
|
|
223 (delta (- desired-height current-height)))
|
|
224 (enlarge-window delta)
|
|
225 (set-buffer buffer)
|
|
226 (goto-char (point-min))
|
|
227
|
|
228 ;; Now repair damage to the window below us, if it still exists.
|
|
229 (let ((lower-window (ilisp-find-lower-window window)))
|
|
230 (if lower-window
|
|
231 (progn
|
|
232 (select-window lower-window)
|
|
233 (let ((old-point (point)))
|
|
234 (goto-char (window-start))
|
|
235 (vertical-motion delta)
|
|
236 (set-window-start lower-window (point))
|
|
237 (goto-char old-point)
|
|
238 (if (not (pos-visible-in-window-p old-point))
|
|
239 (recenter 0))))))
|
|
240 ;; If there was no lower window, then we ought to preserve
|
|
241 ;; the start of the window above us, if any.
|
|
242
|
|
243 (if (ilisp-window-live-p previously-selected-window)
|
|
244 (select-window previously-selected-window)))))
|
|
245
|
|
246
|
|
247
|
|
248 (defun ilisp-window-live-p (window)
|
|
249 (let* ((initial-window (selected-window))
|
|
250 (win initial-window)
|
|
251 (found nil))
|
|
252 (while win
|
|
253 (cond ((eq window win)
|
|
254 (setq found t
|
|
255 win nil))
|
|
256 (t
|
|
257 (setq win (next-window win 'no))
|
|
258 (if (eq win initial-window)
|
|
259 (setq win nil)))))
|
|
260 found))
|
|
261
|
|
262 ;; XEmacs change -- window-edges is gone in 19.12+ so use
|
|
263 ;; next-vertical-window instead.
|
|
264 (defun ilisp-find-lower-window (window)
|
|
265 "Find the window directly below us, if any. This is probably the
|
|
266 window from which enlarge-window would steal lines."
|
4
|
267 (if (or (not (string-match "XEmacs" emacs-version))
|
74
|
268 (and (= emacs-major-version 19)
|
|
269 (< emacs-minor-version 12)))
|
0
|
270 (let* ((bottom (nth 3 (window-edges window)))
|
|
271 (window* nil)
|
|
272 (win window))
|
|
273 (while (not (eq (setq win (next-window win 'no))
|
|
274 window))
|
|
275 (if (and (= (nth 1 (window-edges win))
|
|
276 bottom)
|
|
277 (null window*))
|
|
278 (setq window* win)))
|
|
279 window*)
|
|
280 (next-vertical-window window)))
|
|
281
|
|
282 ;; XEmacs change -- There is now a primitive to do this.
|
|
283 (defun ilisp-find-top-left-most-window ()
|
|
284 "Return the leftmost topmost window on the current screen."
|
4
|
285 (if (or (not (string-match "XEmacs" emacs-version))
|
74
|
286 (and (= emacs-major-version 19)
|
|
287 (< emacs-minor-version 12)))
|
0
|
288 (let* ((window* (selected-window))
|
|
289 (edges* (window-edges window*))
|
|
290 (win nil)
|
|
291 (edges nil)
|
|
292 (start-window window*))
|
|
293 (while (not (eq (setq win (next-window win 'no))
|
|
294 start-window))
|
|
295 (setq edges (window-edges win))
|
|
296 (if (or (< (car (cdr edges)) (car (cdr edges*))) ; top
|
|
297 (and (= (car (cdr edges)) (car (cdr edges*)))
|
|
298 (< (car edges) (car edges*)))) ; left
|
|
299 (setq window* win
|
|
300 edges* edges)))
|
|
301 window*)
|
|
302 (frame-highest-window (selected-frame) 0)))
|
|
303
|
|
304
|
|
305 ;; This causes the typeout window to be created by splitting or using the
|
|
306 ;; top-left-most window on the current screen. That is different behavior
|
|
307 ;; from the popper, which always split the current window.
|
|
308 (defun ilisp-window-to-use-for-typeout ()
|
|
309 (ilisp-find-top-left-most-window))
|
|
310
|
|
311
|
|
312 (defun ilisp-display-buffer-in-typeout-window (buffer)
|
|
313 "Display buffer in a window at the top of the screen."
|
|
314 (let ((window (get-buffer-window buffer)))
|
|
315
|
|
316 ;; If buffer already has a window, keep it.
|
|
317 (if (null window)
|
|
318 ;; Otherwise, find a window to split.
|
|
319 (let* ((top-window (ilisp-window-to-use-for-typeout))
|
|
320 (new-window nil)
|
|
321 (previously-selected-window (selected-window))
|
|
322 (desired-height (ilisp-desired-height buffer)))
|
|
323
|
|
324 ;; The new window is always the lower one.
|
|
325 (select-window top-window)
|
|
326
|
|
327 ;; Always minimize redisplay (except in emacs 18).
|
|
328 (let ((split-window-keep-point nil))
|
|
329 ;; If the top window is not big enough to split, commandeer it
|
|
330 ;; entirely.
|
|
331 (cond ((> desired-height (- (window-height) window-min-height))
|
|
332 (setq new-window top-window))
|
|
333 (t
|
|
334 (setq new-window (split-window-vertically desired-height)))))
|
|
335
|
|
336 (set-window-buffer top-window buffer)
|
|
337 ;; The height is already correct, unless there was line wrapping.
|
|
338 ;; Account for that here.
|
|
339 (ilisp-shrink-wrap-window top-window)
|
|
340
|
|
341 ;; Restore selected window.
|
|
342 (if (eq previously-selected-window top-window)
|
|
343 (select-window new-window)
|
|
344 (select-window previously-selected-window)))
|
|
345
|
|
346 ;; Simply shrink-wrap an existing window.
|
|
347 (ilisp-shrink-wrap-window window))))
|
|
348
|
|
349
|
|
350
|
|
351
|
|
352
|
|
353
|
|
354
|
|
355
|
|
356 ;;; Various functions to which to bind ilisp-display-output-function.
|
|
357
|
|
358 ;; This function does what ilisp used to do, except that we use the
|
|
359 ;; new "popper".
|
|
360
|
|
361 (defun ilisp-display-output-default (output)
|
|
362 "Dispatch on the value of lisp-no-popper:
|
|
363 lisp-no-popper = nil: display output in a typeout window.
|
|
364 lisp-no-popper = t: display output in the ilisp buffer
|
|
365 otherwise: display one-line output in the echo area, multiline output in the ilisp buffer."
|
|
366 (cond ((null lisp-no-popper)
|
|
367 (ilisp-display-output-in-typeout-window output))
|
|
368 ((eq lisp-no-popper t)
|
|
369 (ilisp-display-output-in-lisp-listener output))
|
|
370 (t
|
|
371 (ilisp-display-output-adaptively output))))
|
|
372
|
|
373
|
|
374 ;; This is the display function I like to use.
|
|
375
|
|
376 ;; Another trick which might be useful is to dispatch on the value
|
|
377 ;; this-command here, to make output from different ilisp commands
|
|
378 ;; go to different places.
|
|
379
|
|
380 (defun ilisp-display-output-adaptively (output)
|
|
381 "Display one-liners in the echo area, others in the typeout window"
|
|
382 (cond ((or (string-match "\n" output)
|
|
383 (> (length output) (window-width (minibuffer-window))))
|
|
384 (message "See above.")
|
|
385 (ilisp-display-output-in-typeout-window output))
|
|
386 (t
|
|
387 (ilisp-display-output-in-echo-area output))))
|
|
388
|
|
389
|
|
390 (defun ilisp-display-output-in-typeout-window (output)
|
|
391 "Display output in a shrink-wrapped window at the top of the screen."
|
|
392 (let ((buffer (ilisp-output-buffer t)))
|
|
393 (ilisp-write-string-to-buffer buffer output)
|
|
394 (ilisp-display-buffer-in-typeout-window buffer)))
|
|
395
|
|
396
|
|
397 (defun ilisp-display-output-in-echo-area (output)
|
|
398 "Display output as a message in the echo area."
|
|
399 ;; First clear any existing typeout so as to not confuse the user.
|
|
400 (or (eq (selected-window) (ilisp-output-window))
|
|
401 (ilisp-bury-output))
|
4
|
402
|
|
403 ;; v5.7: Patch suggested by hunter@work.nlm.nih.gov (Larry Hunter)
|
0
|
404 ;; If output contains '%', 'message' loses.
|
|
405 ;; (message (ilisp-quote-%s output))
|
|
406 ;; An alternative here could be '(princ output)', as suggested by
|
|
407 ;; Christopher Hoover <ch@lks.csi.com>
|
4
|
408 ;; (princ output)
|
|
409
|
|
410 ;; v5.7b: Patch suggested by fujieda@jaist.ac.jp (Kazuhiro Fujieda)
|
|
411 ;; Best one for FSF Emacs 19.2[89].
|
|
412 (message "%s" output)
|
0
|
413 )
|
|
414
|
|
415
|
|
416 ;;; ilisp-quote-%s --
|
|
417 ;;; Patch suggested by hunter@work.nlm.nih.gov (Larry Hunter)
|
|
418
|
|
419 (defun ilisp-quote-%s (string)
|
|
420 "Quote all the occurences of ?% in STRING in an ELisp fashion."
|
|
421 (mapconcat '(lambda (char)
|
|
422 (if (char-equal char ?%)
|
|
423 "%%"
|
|
424 (char-to-string char)))
|
|
425 string ""))
|
|
426
|
|
427
|
|
428 (defun ilisp-display-output-in-temp-buffer (output)
|
|
429 (with-output-to-temp-buffer ilisp-output-buffer
|
|
430 (princ output)))
|
|
431
|
|
432
|
|
433 (defun ilisp-display-output-in-lisp-listener (output)
|
|
434 "Display output in the ilisp buffer"
|
|
435 (let ((buffer (current-buffer))
|
|
436 (window (selected-window)))
|
|
437 (unwind-protect
|
|
438 (progn
|
|
439 (lisp-pop-to-buffer (ilisp-buffer))
|
|
440 (if (not (eq (current-buffer) buffer))
|
|
441 (setq ilisp-last-buffer buffer))
|
|
442 (comint-insert
|
|
443 (concat
|
|
444 (if ilisp-last-message
|
|
445 (concat ";;; " ilisp-last-message "\n"))
|
|
446 (comint-remove-whitespace output)
|
|
447 "\n"
|
|
448 ilisp-last-prompt))
|
|
449 (setq ilisp-last-message nil))
|
|
450 (if (window-point window)
|
|
451 (progn (select-window window)
|
|
452 (set-buffer buffer))))))
|
|
453
|
|
454
|
|
455
|
|
456 ;;; Changed according to suggestions by Robert P. Goldman
|
|
457 (defun lisp-pop-to-buffer (buffer)
|
|
458 "Like pop-to-buffer, but select a screen that buffer was shown in."
|
|
459 (let ((ilisp-window (if ilisp-epoch-running
|
|
460 (epoch::get-buffer-window buffer)
|
|
461 (get-buffer-window buffer))))
|
|
462 (if ilisp-window
|
|
463 (select-window ilisp-window)
|
|
464 ;; It is not currently displayed, so find some place to display
|
|
465 ;; it.
|
|
466 (progn
|
|
467 (cond (ilisp-epoch-running
|
|
468 ;; Select a screen that the buffer has been displayed in before
|
|
469 ;; or the current screen otherwise.
|
|
470 (epoch::select-screen
|
|
471 ;; allowed-screens in epoch 3.2, was called screens before that
|
|
472 (or (car (save-excursion
|
|
473 (set-buffer buffer)
|
|
474 (symbol-value 'allowed-screens)))
|
|
475 (epoch::current-screen))))
|
|
476
|
|
477 ;; Next clauses patterned after a suggestion by R. P. Goldman.
|
|
478 ((eq +ilisp-emacs-version-id+ 'fsf-19)
|
|
479 (let* ((window (get-buffer-window buffer t))
|
|
480 (frame (if window (window-frame window))))
|
|
481 (if (eq 'x (framep frame))
|
|
482 (progn
|
|
483 (raise-frame frame)
|
|
484 (select-frame frame)))))
|
|
485 (t nil)) ; fsf-18, but also lucid and
|
|
486 ; xemacs.
|
|
487 ; I do not know how to make
|
|
488 ; them work
|
|
489 ; Marco Antoniotti, Jan 4th 1995
|
|
490 (ilisp-bury-output)
|
|
491 (pop-to-buffer buffer))))
|
|
492 (set-buffer buffer))
|
|
493
|
|
494 ;(defun lisp-pop-to-buffer (buffer)
|
|
495 ; "Like pop-to-buffer, but select a screen that buffer was shown in.
|
|
496 ; Also, first bury any typeout-window."
|
|
497 ; (let ((ilisp-window (if ilisp-epoch-running
|
|
498 ; (epoch::get-buffer-window buffer)
|
|
499 ; (get-buffer-window buffer))))
|
|
500 ; (if ilisp-window
|
|
501 ; (select-window ilisp-window)
|
|
502 ; ;; It is not currently displayed, so find some place to display it.
|
|
503 ; (if ilisp-epoch-running
|
|
504 ; ;; Select a screen that the buffer has been displayed in before
|
|
505 ; ;; or the current screen otherwise.
|
|
506 ; (epoch::select-screen
|
|
507 ; ;; allowed-screens in epoch 3.2, was called screens before that
|
|
508 ; (or (car (save-excursion
|
|
509 ; (set-buffer buffer)
|
|
510 ; (symbol-value 'allowed-screens)))
|
|
511 ; (epoch::current-screen))))
|
|
512 ; ;; Do not pop to the output buffer.
|
|
513 ; (ilisp-bury-output)
|
|
514 ; (pop-to-buffer buffer)))
|
|
515 ; (set-buffer buffer))
|
|
516
|
|
517
|
|
518 ;;;
|
|
519 (defun switch-to-lisp (eob-p &optional ilisp-only)
|
|
520 "If in an ILISP buffer, switch to the buffer that last switched to
|
|
521 an ILISP otherwise, switch to the current ILISP buffer. With
|
|
522 argument, positions cursor at end of buffer. If you don't want to
|
|
523 split windows, set pop-up-windows to NIL."
|
|
524 (interactive "P")
|
|
525 (if (and (not ilisp-only) ilisp-last-buffer
|
|
526 (memq major-mode ilisp-modes))
|
|
527 (lisp-pop-to-buffer ilisp-last-buffer)
|
|
528 (if (not (memq major-mode ilisp-modes))
|
|
529 (setq ilisp-last-buffer (current-buffer)))
|
|
530 (lisp-pop-to-buffer (ilisp-buffer))
|
|
531 (cond (eob-p (goto-char (point-max))))))
|