;;; window.el --- GNU Emacs window commands aside from those written in C
-;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001, 2002, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001, 2002,
+;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(defvar window-size-fixed nil
"*Non-nil in a buffer means windows displaying the buffer are fixed-size.
-If the value is`height', then only the window's height is fixed.
+If the value is `height', then only the window's height is fixed.
If the value is `width', then only the window's width is fixed.
Any other non-nil value fixes both the width and the height.
Emacs won't change the size of any window displaying that buffer,
(defmacro save-selected-window (&rest body)
"Execute BODY, then select the window that was selected before BODY.
-Also restore the selected window of each frame as it was at the start
-of this construct.
-However, if a window has become dead, don't get an error,
-just refrain from reselecting it.
-Return the value of the last form in BODY."
+The value returned is the value of the last form in BODY.
+
+This macro saves and restores the current buffer, since otherwise
+its normal operation could potentially make a different
+buffer current. It does not alter the buffer list ordering.
+
+This macro saves and restores the selected window, as well as
+the selected window in each frame. If the previously selected
+window of some frame is no longer live at the end of BODY, that
+frame's selected window is left alone. If the selected window is
+no longer live, then whatever window is selected at the end of
+BODY remains selected."
`(let ((save-selected-window-window (selected-window))
;; It is necessary to save all of these, because calling
;; select-window changes frame-selected-window for whatever
(save-selected-window-alist
(mapcar (lambda (frame) (list frame (frame-selected-window frame)))
(frame-list))))
- (unwind-protect
- (progn ,@body)
- (dolist (elt save-selected-window-alist)
- (and (frame-live-p (car elt))
- (window-live-p (cadr elt))
- (set-frame-selected-window (car elt) (cadr elt))))
- (if (window-live-p save-selected-window-window)
- (select-window save-selected-window-window)))))
+ (save-current-buffer
+ (unwind-protect
+ (progn ,@body)
+ (dolist (elt save-selected-window-alist)
+ (and (frame-live-p (car elt))
+ (window-live-p (cadr elt))
+ (set-frame-selected-window (car elt) (cadr elt))))
+ (if (window-live-p save-selected-window-window)
+ (select-window save-selected-window-window))))))
(defun window-body-height (&optional window)
"Return number of lines in window WINDOW for actual buffer text.
(defun window-current-scroll-bars (&optional window)
"Return the current scroll-bar settings in window WINDOW.
-Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the
+Value is a cons (VERTICAL . HORIZONTAL) where VERTICAL specifies the
current location of the vertical scroll-bars (left, right, or nil),
-and HORISONTAL specifies the current location of the horisontal scroll
+and HORIZONTAL specifies the current location of the horizontal scroll
bars (top, bottom, or nil)."
(let ((vert (nth 2 (window-scroll-bars window)))
(hor nil))
(defalias 'some-window 'get-window-with-predicate)
+;; This should probably be written in C (i.e., without using `walk-windows').
+(defun get-buffer-window-list (buffer &optional minibuf frame)
+ "Return list of all windows displaying BUFFER, or nil if none.
+BUFFER can be a buffer or a buffer name.
+See `walk-windows' for the meaning of MINIBUF and FRAME."
+ (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
+ (walk-windows (function (lambda (window)
+ (if (eq (window-buffer window) buffer)
+ (setq windows (cons window windows)))))
+ minibuf frame)
+ windows))
+
(defun minibuffer-window-active-p (window)
"Return t if WINDOW (a minibuffer window) is now active."
(eq window (active-minibuffer-window)))
(or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
(= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
-
-(defun balance-windows ()
- "Make all visible windows the same height (approximately)."
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; `balance-windows' subroutines using `window-tree'
+
+;;; Translate from internal window tree format
+
+(defun bw-get-tree (&optional window-or-frame)
+ "Get a window split tree in our format.
+
+WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
+then the whole window split tree for `selected-frame' is returned.
+If it is a frame, then this is used instead. If it is a window,
+then the smallest tree containing that window is returned."
+ (when window-or-frame
+ (unless (or (framep window-or-frame)
+ (windowp window-or-frame))
+ (error "Not a frame or window: %s" window-or-frame)))
+ (let ((subtree (bw-find-tree-sub window-or-frame)))
+ (when subtree
+ (if (integerp subtree)
+ nil
+ (bw-get-tree-1 subtree)))))
+
+(defun bw-get-tree-1 (split)
+ (if (windowp split)
+ split
+ (let ((dir (car split))
+ (edges (car (cdr split)))
+ (childs (cdr (cdr split))))
+ (list
+ (cons 'dir (if dir 'ver 'hor))
+ (cons 'b (nth 3 edges))
+ (cons 'r (nth 2 edges))
+ (cons 't (nth 1 edges))
+ (cons 'l (nth 0 edges))
+ (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
+
+(defun bw-find-tree-sub (window-or-frame &optional get-parent)
+ (let* ((window (when (windowp window-or-frame) window-or-frame))
+ (frame (when (windowp window) (window-frame window)))
+ (wt (car (window-tree frame))))
+ (when (< 1 (length (window-list frame 0)))
+ (if window
+ (bw-find-tree-sub-1 wt window get-parent)
+ wt))))
+
+(defun bw-find-tree-sub-1 (tree win &optional get-parent)
+ (unless (windowp win) (error "Not a window: %s" win))
+ (if (memq win tree)
+ (if get-parent
+ get-parent
+ tree)
+ (let ((childs (cdr (cdr tree)))
+ child
+ subtree)
+ (while (and childs (not subtree))
+ (setq child (car childs))
+ (setq childs (cdr childs))
+ (when (and child (listp child))
+ (setq subtree (bw-find-tree-sub-1 child win get-parent))))
+ (if (integerp subtree)
+ (progn
+ (if (= 1 subtree)
+ tree
+ (1- subtree)))
+ subtree
+ ))))
+
+;;; Window or object edges
+
+(defun bw-l (obj)
+ "Left edge of OBJ."
+ (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
+(defun bw-t (obj)
+ "Top edge of OBJ."
+ (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
+(defun bw-r (obj)
+ "Right edge of OBJ."
+ (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
+(defun bw-b (obj)
+ "Bottom edge of OBJ."
+ (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
+
+;;; Split directions
+
+(defun bw-dir (obj)
+ "Return window split tree direction if OBJ.
+If OBJ is a window return 'both. If it is a window split tree
+then return its direction."
+ (if (symbolp obj)
+ obj
+ (if (windowp obj)
+ 'both
+ (let ((dir (cdr (assq 'dir obj))))
+ (unless (memq dir '(hor ver both))
+ (error "Can't find dir in %s" obj))
+ dir))))
+
+(defun bw-eqdir (obj1 obj2)
+ "Return t if window split tree directions are equal.
+OBJ1 and OBJ2 should be either windows or window split trees in
+our format. The directions returned by `bw-dir' are compared and
+t is returned if they are `eq' or one of them is 'both."
+ (let ((dir1 (bw-dir obj1))
+ (dir2 (bw-dir obj2)))
+ (or (eq dir1 dir2)
+ (eq dir1 'both)
+ (eq dir2 'both))))
+
+;;; Building split tree
+
+(defun bw-refresh-edges (obj)
+ "Refresh the edge information of OBJ and return OBJ."
+ (unless (windowp obj)
+ (let ((childs (cdr (assq 'childs obj)))
+ (ol 1000)
+ (ot 1000)
+ (or -1)
+ (ob -1))
+ (dolist (o childs)
+ (when (> ol (bw-l o)) (setq ol (bw-l o)))
+ (when (> ot (bw-t o)) (setq ot (bw-t o)))
+ (when (< or (bw-r o)) (setq or (bw-r o)))
+ (when (< ob (bw-b o)) (setq ob (bw-b o))))
+ (setq obj (delq 'l obj))
+ (setq obj (delq 't obj))
+ (setq obj (delq 'r obj))
+ (setq obj (delq 'b obj))
+ (add-to-list 'obj (cons 'l ol))
+ (add-to-list 'obj (cons 't ot))
+ (add-to-list 'obj (cons 'r or))
+ (add-to-list 'obj (cons 'b ob))
+ ))
+ obj)
+
+;;; Balance windows
+
+(defun balance-windows (&optional window-or-frame)
+ "Make windows the same heights or widths in window split subtrees.
+
+When called non-interactively WINDOW-OR-FRAME may be either a
+window or a frame. It then balances the windows on the implied
+frame. If the parameter is a window only the corresponding window
+subtree is balanced."
(interactive)
- (let ((count -1) levels newsizes level-size
- ;; Don't count the lines that are above the uppermost windows.
- ;; (These are the menu bar lines, if any.)
- (mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))
- (last-window (previous-window (frame-first-window (selected-frame))))
- ;; Don't count the lines that are past the lowest main window.
- total)
- ;; Bottom edge of last window determines what size we have to work with.
- (setq total
- (+ (window-height last-window)
- (nth 1 (window-edges last-window))))
-
- ;; Find all the different vpos's at which windows start,
- ;; then count them. But ignore levels that differ by only 1.
- (let (tops (prev-top -2))
- (walk-windows (function (lambda (w)
- (setq tops (cons (nth 1 (window-edges w))
- tops))))
- 'nomini)
- (setq tops (sort tops '<))
- (while tops
- (if (> (car tops) (1+ prev-top))
- (setq prev-top (car tops)
- count (1+ count)))
- (setq levels (cons (cons (car tops) count) levels))
- (setq tops (cdr tops)))
- (setq count (1+ count)))
- ;; Subdivide the frame into desired number of vertical levels.
- (setq level-size (/ (- total mbl) count))
- (save-selected-window
- ;; Set up NEWSIZES to map windows to their desired sizes.
- ;; If a window ends at the bottom level, don't include
- ;; it in NEWSIZES. Those windows get the right sizes
- ;; by adjusting the ones above them.
- (walk-windows (function
- (lambda (w)
- (let ((newtop (cdr (assq (nth 1 (window-edges w))
- levels)))
- (newbot (cdr (assq (+ (window-height w)
- (nth 1 (window-edges w)))
- levels))))
- (if newbot
- (setq newsizes
- (cons (cons w (* level-size (- newbot newtop)))
- newsizes))))))
- 'nomini)
- ;; Make walk-windows start with the topmost window.
- (select-window (previous-window (frame-first-window (selected-frame))))
- (let (done (count 0))
- ;; Give each window its precomputed size, or at least try.
- ;; Keep trying until they all get the intended sizes,
- ;; but not more than 3 times (to prevent infinite loop).
- (while (and (not done) (< count 3))
- (setq done t)
- (setq count (1+ count))
- (walk-windows (function (lambda (w)
- (select-window w)
- (let ((newsize (cdr (assq w newsizes))))
- (when newsize
- (enlarge-window (- newsize
- (window-height))
- nil t)
- (unless (= (window-height) newsize)
- (setq done nil))))))
- 'nomini))))))
+ (let (
+ (wt (bw-get-tree window-or-frame))
+ (w)
+ (h)
+ (tried-sizes)
+ (last-sizes)
+ (windows (window-list nil 0))
+ (counter 0))
+ (when wt
+ (while (not (member last-sizes tried-sizes))
+ (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
+ (setq last-sizes (mapcar (lambda (w)
+ (window-edges w))
+ windows))
+ (when (eq 'hor (bw-dir wt))
+ (setq w (- (bw-r wt) (bw-l wt))))
+ (when (eq 'ver (bw-dir wt))
+ (setq h (- (bw-b wt) (bw-t wt))))
+ (bw-balance-sub wt w h)))))
+
+(defun bw-adjust-window (window delta horizontal)
+ "Wrapper around `adjust-window-trailing-edge' with error checking.
+Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
+ (condition-case err
+ (adjust-window-trailing-edge window delta horizontal)
+ (error
+ ;;(message "adjust: %s" (error-message-string err))
+ )))
+
+(defun bw-balance-sub (wt w h)
+ (setq wt (bw-refresh-edges wt))
+ (unless w (setq w (- (bw-r wt) (bw-l wt))))
+ (unless h (setq h (- (bw-b wt) (bw-t wt))))
+ (if (windowp wt)
+ (progn
+ (when w
+ (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
+ (when (/= 0 dw)
+ (bw-adjust-window wt dw t))))
+ (when h
+ (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
+ (when (/= 0 dh)
+ (bw-adjust-window wt dh nil)))))
+ (let* ((childs (cdr (assq 'childs wt)))
+ (lastchild (car (last childs)))
+ (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
+ (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
+ (dolist (c childs)
+ (bw-balance-sub c cw ch)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
\f
;; I think this should be the default; I think people will prefer it--rms.
(defcustom split-window-keep-point t
This option applies only to `split-window-vertically' and
functions that call it. `split-window' always keeps the original
-point in both children,"
+point in both children."
:type 'boolean
:group 'windows)
lines than are actually needed in the case where some error may be present."
(let ((delta (- height (window-text-height window))))
(unless (zerop delta)
- (let ((window-min-height 1))
+ ;; Setting window-min-height to a value like 1 can lead to very
+ ;; bizarre displays because it also allows Emacs to make *other*
+ ;; windows 1-line tall, which means that there's no more space for
+ ;; the modeline.
+ (let ((window-min-height (min 2 height))) ;One text line plus a modeline.
(if (and window (not (eq window (selected-window))))
(save-selected-window
(select-window window)
(1+ (vertical-motion (buffer-size) window))))))
(defun fit-window-to-buffer (&optional window max-height min-height)
- "Make WINDOW the right size to display its contents exactly.
+ "Make WINDOW the right height to display its contents exactly.
If WINDOW is omitted or nil, it defaults to the selected window.
If the optional argument MAX-HEIGHT is supplied, it is the maximum height
the window is allowed to be, defaulting to the frame height.
Do not shrink to less than `window-min-height' lines.
Do nothing if the buffer contains more lines than the present window height,
or if some of the window's contents are scrolled out of view,
-or if shrinking this window would also shrink another window.
+or if shrinking this window would also shrink another window,
or if the window is the only window of its frame."
(interactive)
(when (null window)
;; Maybe get rid of the window.
(and window (not window-handled) (not window-solitary)
(delete-window window))))
+\f
+(defvar mouse-autoselect-window-timer nil
+ "Timer used by delayed window autoselection.")
+
+(defvar mouse-autoselect-window-position nil
+ "Last mouse position recorded by delayed window autoselection.")
+
+(defvar mouse-autoselect-window-window nil
+ "Last window recorded by delayed window autoselection.")
+
+(defvar mouse-autoselect-window-now nil
+ "When non-nil don't delay autoselection in `handle-select-window'.")
+
+(defun mouse-autoselect-window-cancel (&optional force)
+ "Cancel delayed window autoselection.
+Optional argument FORCE means cancel unconditionally."
+ (unless (and (not force)
+ ;; Don't cancel while the user drags a scroll bar.
+ (eq this-command 'scroll-bar-toolkit-scroll)
+ (memq (nth 4 (event-end last-input-event))
+ '(handle end-scroll)))
+ (setq mouse-autoselect-window-now nil)
+ (when (timerp mouse-autoselect-window-timer)
+ (cancel-timer mouse-autoselect-window-timer))
+ (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
+
+(defun mouse-autoselect-window-start (window)
+ "Start delayed window autoselection.
+Called when Emacs detects that the mouse has moved to the non-selected
+window WINDOW and the variable `mouse-autoselect-window' has a numeric,
+non-zero value. The return value is non-nil iff delayed autoselection
+started successfully. Delayed window autoselection is canceled when the
+mouse position has stabilized or a command is executed."
+ ;; Cancel any active window autoselection.
+ (mouse-autoselect-window-cancel t)
+ ;; Record current mouse position in `mouse-autoselect-window-position' and
+ ;; WINDOW in `mouse-autoselect-window-window'.
+ (setq mouse-autoselect-window-position (mouse-position))
+ (setq mouse-autoselect-window-window window)
+ ;; Install timer which runs `mouse-autoselect-window-select' every
+ ;; `mouse-autoselect-window' seconds.
+ (setq mouse-autoselect-window-timer
+ (run-at-time
+ (abs mouse-autoselect-window) (abs mouse-autoselect-window)
+ 'mouse-autoselect-window-select))
+ ;; Executing a command cancels window autoselection.
+ (add-hook 'pre-command-hook 'mouse-autoselect-window-cancel))
+
+(defun mouse-autoselect-window-select ()
+ "Select window with delayed window autoselection.
+If the mouse position has stabilized in a non-selected window, select
+that window. The minibuffer window is selected iff the minibuffer is
+active. This function is run by `mouse-autoselect-window-timer'."
+ (condition-case nil
+ (let* ((mouse-position (mouse-position))
+ (window (window-at (cadr mouse-position) (cddr mouse-position)
+ (car mouse-position))))
+ (cond
+ ((and window (not (eq window (selected-window)))
+ (or (not (numberp mouse-autoselect-window))
+ (and (> mouse-autoselect-window 0)
+ ;; If `mouse-autoselect-window' is positive, select
+ ;; window if the window is the same as before.
+ (eq window mouse-autoselect-window-window))
+ ;; Otherwise select window iff the mouse is at the same
+ ;; position as before. Observe that the first test after
+ ;; `mouse-autoselect-window-start' usually fails since the
+ ;; value of `mouse-autoselect-window-position' recorded there
+ ;; is the position where the mouse has entered the new window
+ ;; and not necessarily where the mouse has stopped moving.
+ (equal mouse-position mouse-autoselect-window-position))
+ ;; The minibuffer is a candidate window iff it's active.
+ (or (not (window-minibuffer-p window))
+ (eq window (active-minibuffer-window))))
+ ;; Mouse position has stabilized in non-selected window: Cancel window
+ ;; autoselection and try to select that window.
+ (mouse-autoselect-window-cancel t)
+ ;; Select window where mouse appears unless the selected window is the
+ ;; minibuffer. Use `unread-command-events' in order to execute pre-
+ ;; and post-command hooks and trigger idle timers. To avoid delaying
+ ;; autoselection again, temporarily set `mouse-autoselect-window-now'
+ ;; to t.
+ (unless (window-minibuffer-p (selected-window))
+ (setq mouse-autoselect-window-now t)
+ (setq unread-command-events
+ (cons (list 'select-window (list window))
+ unread-command-events))))
+ ((or (and window (eq window (selected-window)))
+ (not (numberp mouse-autoselect-window))
+ (equal mouse-position mouse-autoselect-window-position))
+ ;; Mouse position has either stabilized in the selected window or at
+ ;; `mouse-autoselect-window-position': Cancel window autoselection.
+ (mouse-autoselect-window-cancel t))
+ (t
+ ;; Mouse position has not stabilized yet, record new mouse position in
+ ;; `mouse-autoselect-window-position' and any window at that position
+ ;; in `mouse-autoselect-window-window'.
+ (setq mouse-autoselect-window-position mouse-position)
+ (setq mouse-autoselect-window-window window))))
+ (error nil)))
(defun handle-select-window (event)
"Handle select-window events."
(interactive "e")
(let ((window (posn-window (event-start event))))
- (if (and (window-live-p window)
- ;; Don't switch if we're currently in the minibuffer.
- ;; This tries to work around problems where the minibuffer gets
- ;; unselected unexpectedly, and where you then have to move
- ;; your mouse all the way down to the minibuffer to select it.
- (not (window-minibuffer-p (selected-window)))
- ;; Don't switch to a minibuffer window unless it's active.
- (or (not (window-minibuffer-p window))
- (minibuffer-window-active-p window)))
- (select-window window))))
+ (when (and (window-live-p window)
+ ;; Don't switch if we're currently in the minibuffer.
+ ;; This tries to work around problems where the minibuffer gets
+ ;; unselected unexpectedly, and where you then have to move
+ ;; your mouse all the way down to the minibuffer to select it.
+ (not (window-minibuffer-p (selected-window)))
+ ;; Don't switch to a minibuffer window unless it's active.
+ (or (not (window-minibuffer-p window))
+ (minibuffer-window-active-p window)))
+ (unless (and (numberp mouse-autoselect-window)
+ (not (zerop mouse-autoselect-window))
+ (not mouse-autoselect-window-now)
+ ;; When `mouse-autoselect-window' has a numeric, non-zero
+ ;; value, delay window autoselection by that value.
+ ;; `mouse-autoselect-window-start' returns non-nil iff it
+ ;; successfully installed a timer for this purpose.
+ (mouse-autoselect-window-start window))
+ ;; Re-enable delayed window autoselection.
+ (setq mouse-autoselect-window-now nil)
+ (when mouse-autoselect-window
+ ;; Run `mouse-leave-buffer-hook' when autoselecting window.
+ (run-hooks 'mouse-leave-buffer-hook))
+ (select-window window)))))
(define-key ctl-x-map "2" 'split-window-vertically)
(define-key ctl-x-map "3" 'split-window-horizontally)