annotate lisp/ilisp/ilisp-out.el @ 205:92f8ad5d0d3f r20-4b1

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