;;; 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:
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,
+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
(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.
;; 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)
HCoop / bpt / emacs.git / blobdiff