(UU+8B71): Unify AJ1-06190.
[chise/xemacs-chise.git.1] / lisp / window.el
1 ;;; window.el --- XEmacs window commands aside from those written in C.
2
3 ;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing.
5
6 ;; Maintainer: XEmacs Development Team
7 ;; Keywords: frames, extensions, dumped
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING.  If not, write to the
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Synched up with: Emacs/Mule zeta.
27
28 ;;; Commentary:
29
30 ;; This file is dumped with XEmacs.
31
32 ;;; Code:
33
34 ;;;; Window tree functions.
35
36 (defun one-window-p (&optional nomini which-frames which-devices)
37   "Return non-nil if the selected window is the only window (in its frame).
38 Optional arg NOMINI non-nil means don't count the minibuffer
39 even if it is active.
40
41 By default, only the windows in the selected frame are considered.
42 The optional argument WHICH-FRAMES changes this behavior:
43 WHICH-FRAMES nil or omitted means count only the selected frame,
44 plus the minibuffer it uses (which may be on another frame).
45 WHICH-FRAMES = `visible' means include windows on all visible frames.
46 WHICH-FRAMES = 0 means include windows on all visible and iconified frames.
47 WHICH-FRAMES = t means include windows on all frames including invisible frames.
48 If WHICH-FRAMES is any other value, count only the selected frame.
49
50 The optional third argument WHICH-DEVICES further clarifies on which
51 devices to search for frames as specified by WHICH-FRAMES.  This value
52 is only meaningful if WHICH-FRAMES is non-nil.
53 If nil or omitted, search all devices on the selected console.
54 If a device, only search that device.
55 If a console, search all devices on that console.
56 If a device type, search all devices of that type.
57 If `window-system', search all devices on window-system consoles.
58 Any other non-nil value means search all devices."
59   (let ((base-window (selected-window)))
60     (if (and nomini (eq base-window (minibuffer-window)))
61         (setq base-window (next-window base-window)))
62     (eq base-window
63         (next-window base-window (if nomini 'arg) which-frames which-devices))))
64
65 (defun walk-windows (function &optional minibuf which-frames which-devices)
66   "Cycle through all visible windows, calling FUNCTION for each one.
67 FUNCTION is called with a window as argument.
68
69 Optional second arg MINIBUF t means count the minibuffer window even
70 if not active.  MINIBUF nil or omitted means count the minibuffer iff
71 it is active.  MINIBUF neither t nor nil means not to count the
72 minibuffer even if it is active.
73
74 Several frames may share a single minibuffer; if the minibuffer
75 counts, all windows on all frames that share that minibuffer count
76 too.  Therefore, when a separate minibuffer frame is active,
77 `walk-windows' includes the windows in the frame from which you
78 entered the minibuffer, as well as the minibuffer window.  But if the
79 minibuffer does not count, only the selected window counts.
80
81 By default, only the windows in the selected frame are included.
82 The optional argument WHICH-FRAMES changes this behavior:
83 WHICH-FRAMES nil or omitted means cycle within the frames as specified above.
84 WHICH-FRAMES = `visible' means include windows on all visible frames.
85 WHICH-FRAMES = 0 means include windows on all visible and iconified frames.
86 WHICH-FRAMES = t means include windows on all frames including invisible frames.
87 Anything else means restrict to WINDOW's frame.
88
89 The optional fourth argument WHICH-DEVICES further clarifies on which
90 devices to search for frames as specified by WHICH-FRAMES.  This value
91 is only meaningful if WHICH-FRAMES is non-nil.
92 If nil or omitted, search all devices on the selected console.
93 If a device, only search that device.
94 If a console, search all devices on that console.
95 If a device type, search all devices of that type.
96 If `window-system', search all devices on window-system consoles.
97 Any other non-nil value means search all devices."
98   ;; If we start from the minibuffer window, don't fail to come back to it.
99   (if (window-minibuffer-p (selected-window))
100       (setq minibuf t))
101   ;; Note that, like next-window & previous-window, this behaves a little
102   ;; strangely if the selected window is on an invisible frame: it hits
103   ;; some of the windows on that frame, and all windows on visible frames.
104   (let* ((walk-windows-start (selected-window))
105          (walk-windows-current walk-windows-start))
106     (while (progn
107              (setq walk-windows-current
108                    (next-window walk-windows-current minibuf which-frames
109                                 which-devices))
110              (funcall function walk-windows-current)
111              (not (eq walk-windows-current walk-windows-start))))))
112 ;; The old XEmacs definition of the above clause.  It's more correct in
113 ;; that it will never hit a window that's already been hit even if you
114 ;; do something odd like `delete-other-windows', but has the problem
115 ;; that it conses. (This may be called repeatedly, from lazy-lock
116 ;; for example.)
117 ;  (let* ((walk-windows-history nil)
118 ;        (walk-windows-current (selected-window)))
119 ;    (while (progn
120 ;            (setq walk-windows-current
121 ;                  (next-window walk-windows-current minibuf which-frames
122 ;                               which-devices))
123 ;            (not (memq walk-windows-current walk-windows-history)))
124 ;      (setq walk-windows-history (cons walk-windows-current
125 ;                                      walk-windows-history))
126 ;      (funcall function walk-windows-current))))
127
128 (defun minibuffer-window-active-p (window)
129   "Return t if WINDOW (a minibuffer window) is now active."
130   (eq window (active-minibuffer-window)))
131
132 (defmacro save-selected-window (&rest body)
133   "Execute BODY, then select the window that was selected before BODY.
134 The value returned is the value of the last form in BODY."
135   (let ((old-window (gensym "ssw")))
136   `(let ((,old-window (selected-window)))
137      (unwind-protect
138          (progn ,@body)
139        (when (window-live-p ,old-window)
140          (select-window ,old-window))))))
141
142 (defmacro with-selected-window (window &rest body)
143   "Execute forms in BODY with WINDOW as the selected window.
144 The value returned is the value of the last form in BODY."
145   `(save-selected-window
146      (select-window ,window)
147      ,@body))
148
149 \f
150 (defun count-windows (&optional minibuf)
151    "Return the number of visible windows.
152 Optional arg MINIBUF non-nil means count the minibuffer
153 even if it is inactive."
154    (let ((count 0))
155      (walk-windows (function (lambda (w)
156                                (setq count (+ count 1))))
157                    minibuf)
158      count))
159
160 (defun balance-windows ()
161   "Make all visible windows the same height (approximately)."
162   (interactive)
163   (let ((count -1) levels newsizes size)
164         ;FSFmacs
165         ;;; Don't count the lines that are above the uppermost windows.
166         ;;; (These are the menu bar lines, if any.)
167         ;(mbl (nth 1 (window-edges (frame-first-window (selected-frame))))))
168     ;; Find all the different vpos's at which windows start,
169     ;; then count them.  But ignore levels that differ by only 1.
170     (save-window-excursion
171       (let (tops (prev-top -2))
172         (walk-windows (function (lambda (w)
173                         (setq tops (cons (nth 1 (window-pixel-edges w))
174                                          tops))))
175                       'nomini)
176         (setq tops (sort tops '<))
177         (while tops
178           (if (> (car tops) (1+ prev-top))
179               (setq prev-top (car tops)
180                     count (1+ count)))
181           (setq levels (cons (cons (car tops) count) levels))
182           (setq tops (cdr tops)))
183         (setq count (1+ count))))
184     ;; Subdivide the frame into that many vertical levels.
185     ;FSFmacs (setq size (/ (- (frame-height) mbl) count))
186     (setq size (/ (window-pixel-height (frame-root-window)) count))
187     (walk-windows (function
188                    (lambda (w)
189                     (select-window w)
190                     (let ((newtop (cdr (assq (nth 1 (window-pixel-edges))
191                                              levels)))
192                           (newbot (or (cdr (assq
193                                             (+ (window-pixel-height)
194                                                (nth 1 (window-pixel-edges)))
195                                             levels))
196                                       count)))
197                       (setq newsizes
198                             (cons (cons w (* size (- newbot newtop)))
199                                   newsizes)))))
200                   'nomini)
201     (walk-windows (function (lambda (w)
202                               (select-window w)
203                               (let ((newsize (cdr (assq w newsizes))))
204                                 (enlarge-window
205                                  (/ (- newsize (window-pixel-height))
206                                     (face-height 'default))))))
207                   'nomini)))
208 \f
209 ;;; I think this should be the default; I think people will prefer it--rms.
210 (defcustom split-window-keep-point t
211   "*If non-nil, split windows keeps the original point in both children.
212 This is often more convenient for editing.
213 If nil, adjust point in each of the two windows to minimize redisplay.
214 This is convenient on slow terminals, but point can move strangely."
215   :type 'boolean
216   :group 'windows)
217
218 (defun split-window-vertically (&optional arg)
219   "Split current window into two windows, one above the other.
220 The uppermost window gets ARG lines and the other gets the rest.
221 Negative arg means select the size of the lowermost window instead.
222 With no argument, split equally or close to it.
223 Both windows display the same buffer now current.
224
225 If the variable split-window-keep-point is non-nil, both new windows
226 will get the same value of point as the current window.  This is often
227 more convenient for editing.
228
229 Otherwise, we choose window starts so as to minimize the amount of
230 redisplay; this is convenient on slow terminals.  The new selected
231 window is the one that the current value of point appears in.  The
232 value of point can change if the text around point is hidden by the
233 new mode line.
234
235 Programs should probably use split-window instead of this."
236   (interactive "P")
237   (let ((old-w (selected-window))
238         (old-point (point))
239         (size (and arg (prefix-numeric-value arg)))
240         (window-full-p nil)
241         new-w bottom moved)
242     (and size (< size 0) (setq size (+ (window-height) size)))
243     (setq new-w (split-window nil size))
244     (or split-window-keep-point
245         (progn
246           (save-excursion
247             (set-buffer (window-buffer))
248             (goto-char (window-start))
249             (setq moved (vertical-motion (window-height)))
250             (set-window-start new-w (point))
251             (if (> (point) (window-point new-w))
252                 (set-window-point new-w (point)))
253             (and (= moved (window-height))
254                  (progn
255                    (setq window-full-p t)
256                    (vertical-motion -1)))
257             (setq bottom (point)))
258           (and window-full-p
259                (<= bottom (point))
260                (set-window-point old-w (1- bottom)))
261           (and window-full-p
262                (<= (window-start new-w) old-point)
263                (progn
264                  (set-window-point new-w old-point)
265                  (select-window new-w)))))
266     new-w))
267
268 (defun split-window-horizontally (&optional arg)
269   "Split current window into two windows side by side.
270 This window becomes the leftmost of the two, and gets ARG columns.
271 Negative arg means select the size of the rightmost window instead.
272 No arg means split equally."
273   (interactive "P")
274   (let ((size (and arg (prefix-numeric-value arg))))
275     (and size (< size 0)
276          (setq size (+ (window-width) size)))
277     (split-window nil size t)))
278 \f
279 (defun enlarge-window-horizontally (arg)
280   "Make current window ARG columns wider."
281   (interactive "p")
282   (enlarge-window arg t))
283
284 (defun shrink-window-horizontally (arg)
285   "Make current window ARG columns narrower."
286   (interactive "p")
287   (shrink-window arg t))
288
289 (defun shrink-window-if-larger-than-buffer (&optional window)
290   "Shrink the WINDOW to be as small as possible to display its contents.
291 Do not shrink to less than `window-min-height' lines.
292 Do nothing if the buffer contains more lines than the present window height,
293 or if some of the window's contents are scrolled out of view,
294 or if the window is not the full width of the frame,
295 or if the window is the only window of its frame."
296   (interactive)
297   (or window (setq window (selected-window)))
298   (save-excursion
299     (set-buffer (window-buffer window))
300     (let ((n 0)
301           (test-pos
302            (- (point-max)
303               ;; If buffer ends with a newline, ignore it when counting
304               ;; height unless point is after it.
305               (if (and (not (eobp))
306                        (eq ?\n (char-after (1- (point-max)))))
307                   1 0)))
308           (mini (frame-property (window-frame window) 'minibuffer)))
309       (if (and (< 1 (let ((frame (selected-frame)))
310                       (select-frame (window-frame window))
311                       (unwind-protect
312                           (count-windows)
313                         (select-frame frame))))
314                ;; check to make sure that the window is the full width
315                ;; of the frame
316                (window-leftmost-p window)
317                (window-rightmost-p window)
318                ;; The whole buffer must be visible.
319                (pos-visible-in-window-p (point-min) window)
320                ;; The frame must not be minibuffer-only.
321                (not (eq mini 'only)))
322           (progn
323             (save-window-excursion
324               (goto-char (point-min))
325               (while (and (window-live-p window)
326                           (pos-visible-in-window-p test-pos window))
327                 (shrink-window 1 nil window)
328                 (setq n (1+ n))))
329             (if (> n 0)
330                 (shrink-window (min (1- n)
331                                     (- (window-height window)
332                                        (1+ window-min-height)))
333                                nil
334                                window)))))))
335
336 (defun kill-buffer-and-window ()
337   "Kill the current buffer and delete the selected window."
338   (interactive)
339   (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name)))
340       (let ((buffer (current-buffer)))
341         (delete-window (selected-window))
342         (kill-buffer buffer))
343     (error "Aborted")))
344
345 (defun window-list (&optional minibuf which-frames which-devices)
346   "Return a list of existing windows.
347 If the optional argument MINIBUF is non-nil, then include minibuffer
348 windows in the result.
349
350 By default, only the windows in the selected frame are returned.
351 The optional argument WHICH-FRAMES changes this behavior:
352 WHICH-FRAMES = `visible' means include windows on all visible frames.
353 WHICH-FRAMES = 0 means include windows on all visible and iconified frames.
354 WHICH-FRAMES = t means include windows on all frames including invisible frames.
355 Anything else means restrict to the selected frame.
356
357 The optional fourth argument WHICH-DEVICES further clarifies on which
358 devices to search for frames as specified by WHICH-FRAMES.  This value
359 is only meaningful if WHICH-FRAMES is non-nil.
360 If nil or omitted, search all devices on the selected console.
361 If a device, only search that device.
362 If a console, search all devices on that console.
363 If a device type, search all devices of that type.
364 If `window-system', search all devices on window-system consoles.
365 Any other non-nil value means search all devices."
366   (let ((wins nil))
367     (walk-windows (lambda (win)
368                     (push win wins))
369                   minibuf which-frames which-devices)
370     wins))
371
372 ;;; window.el ends here