cgit.sxemacs.org Git - sxemacs/blob - lisp/window.el

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