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