;;; window.el --- GNU Emacs window commands aside from those written in C
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2015 Free Software
+;; Copyright (C) 1985, 1989, 1992-1994, 2000-2016 Free Software
;; Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
(ncols (/ window-width font-width)))
(if (and (display-graphic-p)
overflow-newline-into-fringe
- (/= (frame-parameter nil 'left-fringe) 0)
- (/= (frame-parameter nil 'right-fringe) 0))
+ (not
+ (or (eq left-fringe-width 0)
+ (and (null left-fringe-width)
+ (= (frame-parameter nil 'left-fringe) 0))))
+ (not
+ (or (eq right-fringe-width 0)
+ (and (null right-fringe-width)
+ (= (frame-parameter nil 'right-fringe) 0)))))
ncols
+ ;; FIXME: This should remove 1 more column when there are no
+ ;; fringes, lines are truncated, and the window is hscrolled,
+ ;; but EOL is not in the view, because then there are 2
+ ;; truncation glyphs, not one.
(1- ncols)))))
(defun window-current-scroll-bars (&optional window)
;; Predecessors to the below have been devised by Julian Assange in
;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
-;; Neither of these allow to selectively ignore specific windows
+;; Neither of these allow one to selectively ignore specific windows
;; (windows whose `no-other-window' parameter is non-nil) as targets of
;; the movement.
(defun window-in-direction (direction &optional window ignore sign wrap mini)
Optional argument MINI nil means to return the minibuffer window
if and only if it is currently active. MINI non-nil means to
return the minibuffer window even when it's not active. However,
-if WRAP non-nil, always act as if MINI were nil.
+if WRAP is non-nil, always act as if MINI were nil.
Return nil if no suitable window can be found."
(setq window (window-normalize-window window t))
(when (window-right window)
(window--resize-reset-1 (window-right window) horizontal)))
-;; The following routine is used to manually resize the minibuffer
-;; window and is currently used, for example, by ispell.el.
(defun window--resize-mini-window (window delta)
"Resize minibuffer window WINDOW by DELTA pixels.
If WINDOW cannot be resized by DELTA pixels make it as large (or
(setq ignore 'preserved)
(setq right first-right)
(while (and right
- (or (window-size-fixed-p right horizontal 'preserved))
- (<= (window-size right horizontal t)
- (window-min-size right horizontal 'preserved t)))
+ (or (window-size-fixed-p right horizontal 'preserved)
+ (<= (window-size right horizontal t)
+ (window-min-size right horizontal 'preserved t))))
(setq right
(or (window-right right)
(progn
(cond
((zerop delta))
((window-size-fixed-p nil horizontal)
- (error "Selected window has fixed size"))
+ (user-error "Selected window has fixed size"))
((window-minibuffer-p)
(if horizontal
- (error "Cannot resize minibuffer window horizontally")
- (window--resize-mini-window (selected-window) delta)))
+ (user-error "Cannot resize minibuffer window horizontally")
+ (window--resize-mini-window
+ (selected-window) (* delta (frame-char-height)))))
((and (not horizontal)
(window-full-height-p)
(eq (window-frame minibuffer-window) (selected-frame))
(not resize-mini-windows))
;; If the selected window is full height and `resize-mini-windows'
;; is nil, resize the minibuffer window.
- (window--resize-mini-window minibuffer-window (- delta)))
+ (window--resize-mini-window
+ minibuffer-window (* (- delta) (frame-char-height))))
((window--resizable-p nil delta horizontal)
(window-resize nil delta horizontal))
+ ((window--resizable-p nil delta horizontal 'preserved)
+ (window-resize nil delta horizontal 'preserved))
+ ((eq this-command
+ (if horizontal 'enlarge-window-horizontally 'enlarge-window))
+ ;; For backward compatibility don't signal an error unless this
+ ;; command is `enlarge-window(-horizontally)'.
+ (user-error "Cannot enlarge selected window"))
(t
(window-resize
nil (if (> delta 0)
Interactively, if no argument is given, make the selected window
one line smaller. If optional argument HORIZONTAL is non-nil,
make selected window narrower by DELTA columns. If DELTA is
-negative, enlarge selected window by -DELTA lines or columns.
-Also see the `window-min-height' variable."
+negative, enlarge selected window by -DELTA lines or columns."
(interactive "p")
(let ((minibuffer-window (minibuffer-window)))
(when (window-preserved-size nil horizontal)
(cond
((zerop delta))
((window-size-fixed-p nil horizontal)
- (error "Selected window has fixed size"))
+ (user-error "Selected window has fixed size"))
((window-minibuffer-p)
(if horizontal
- (error "Cannot resize minibuffer window horizontally")
- (window--resize-mini-window (selected-window) (- delta))))
+ (user-error "Cannot resize minibuffer window horizontally")
+ (window--resize-mini-window
+ (selected-window) (* (- delta) (frame-char-height)))))
((and (not horizontal)
(window-full-height-p)
(eq (window-frame minibuffer-window) (selected-frame))
(not resize-mini-windows))
;; If the selected window is full height and `resize-mini-windows'
;; is nil, resize the minibuffer window.
- (window--resize-mini-window minibuffer-window delta))
+ (window--resize-mini-window
+ minibuffer-window (* delta (frame-char-height))))
((window--resizable-p nil (- delta) horizontal)
(window-resize nil (- delta) horizontal))
+ ((window--resizable-p nil (- delta) horizontal 'preserved)
+ (window-resize nil (- delta) horizontal 'preserved))
+ ((eq this-command
+ (if horizontal 'shrink-window-horizontally 'shrink-window))
+ ;; For backward compatibility don't signal an error unless this
+ ;; command is `shrink-window(-horizontally)'.
+ (user-error "Cannot shrink selected window"))
(t
(window-resize
nil (if (> delta 0)
(set-window-parameter (window-parent new) 'window-atom t))
(set-window-parameter new 'window-atom t)))
- ;; Sanitize sizes.
- (window--sanitize-window-sizes frame horizontal)
+ ;; Sanitize sizes unless SIZE was specified.
+ (unless size
+ (window--sanitize-window-sizes frame horizontal))
(run-window-configuration-change-hook frame)
(run-window-scroll-functions new)
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame (window-frame window)))))))
+(defun display-buffer-reuse-mode-window (buffer alist)
+ "Return a window based on the mode of the buffer it displays.
+Display BUFFER in the returned window. Return nil if no usable
+window is found.
+
+If ALIST contains a `mode' entry, its value is a major mode (a
+symbol) or a list of modes. A window is a candidate if it
+displays a buffer that derives from one of the given modes. When
+ALIST contains no `mode' entry, the current major mode of BUFFER
+is used.
+
+The behaviour is also controlled by entries for
+`inhibit-same-window', `reusable-frames' and
+`inhibit-switch-frame' as is done in the function
+`display-buffer-reuse-window'."
+ (let* ((alist-entry (assq 'reusable-frames alist))
+ (alist-mode-entry (assq 'mode alist))
+ (frames (cond (alist-entry (cdr alist-entry))
+ ((if (eq pop-up-frames 'graphic-only)
+ (display-graphic-p)
+ pop-up-frames)
+ 0)
+ (display-buffer-reuse-frames 0)
+ (t (last-nonminibuffer-frame))))
+ (inhibit-same-window-p (cdr (assq 'inhibit-same-window alist)))
+ (windows (window-list-1 nil 'nomini frames))
+ (buffer-mode (with-current-buffer buffer major-mode))
+ (allowed-modes (if alist-mode-entry
+ (cdr alist-mode-entry)
+ buffer-mode))
+ (curwin (selected-window))
+ (curframe (selected-frame)))
+ (unless (listp allowed-modes)
+ (setq allowed-modes (list allowed-modes)))
+ (let (same-mode-same-frame
+ same-mode-other-frame
+ derived-mode-same-frame
+ derived-mode-other-frame)
+ (dolist (window windows)
+ (let (mode? frame?)
+ (with-current-buffer (window-buffer window)
+ (setq mode?
+ (cond ((memq major-mode allowed-modes)
+ 'same)
+ ((derived-mode-p allowed-modes)
+ 'derived))))
+ (when (and mode?
+ (not (and inhibit-same-window-p
+ (eq window curwin))))
+ (if (eq curframe (window-frame window))
+ (if (eq mode? 'same)
+ (push window same-mode-same-frame)
+ (push window derived-mode-same-frame))
+ (if (eq mode? 'same)
+ (push window same-mode-other-frame)
+ (push window derived-mode-other-frame))))))
+ (let ((window (car (nconc same-mode-same-frame
+ same-mode-other-frame
+ derived-mode-same-frame
+ derived-mode-other-frame))))
+ (when (window-live-p window)
+ (prog1 (window--display-buffer buffer window 'reuse alist)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame (window-frame window)))))))))
+
(defun display-buffer--special-action (buffer)
"Return special display action for BUFFER, if any.
If `special-display-p' returns non-nil for BUFFER, return an
buffer))
(other-buffer)))
-(defcustom switch-to-buffer-preserve-window-point nil
+(defcustom switch-to-buffer-preserve-window-point t
"If non-nil, `switch-to-buffer' tries to preserve `window-point'.
If this is nil, `switch-to-buffer' displays the buffer at that
buffer's `point'. If this is `already-displayed', it tries to
(const :tag "If already displayed elsewhere" already-displayed)
(const :tag "Always" t))
:group 'windows
- :version "24.3")
+ :version "25.2")
(defcustom switch-to-buffer-in-dedicated-window nil
"Allow switching to buffer in strongly dedicated windows.
(with-current-buffer buffer-to-kill
(remove-hook 'kill-buffer-hook delete-window-hook t))))))
+\f
+;;;
+;; Groups of windows (Follow Mode).
+;;
+;; This section of functions extends the functionality of some window
+;; manipulating commands to groups of windows cooperatively
+;; displaying a buffer, typically with Follow Mode.
+;;
+;; The xxx-function variables are permanent locals so that their local
+;; status is undone only when explicitly programmed, not when a buffer
+;; is reverted or a mode function is called.
+
+(defvar window-group-start-function nil)
+(make-variable-buffer-local 'window-group-start-function)
+(put 'window-group-start-function 'permanent-local t)
+(defun window-group-start (&optional window)
+ "Return position at which display currently starts in the group of
+windows containing WINDOW. When a grouping mode (such as Follow Mode)
+is not active, this function is identical to `window-start'.
+
+WINDOW must be a live window and defaults to the selected one.
+This is updated by redisplay or by calling `set-window*-start'."
+ (if (functionp window-group-start-function)
+ (funcall window-group-start-function window)
+ (window-start window)))
+
+(defvar window-group-end-function nil)
+(make-variable-buffer-local 'window-group-end-function)
+(put 'window-group-end-function 'permanent-local t)
+(defun window-group-end (&optional window update)
+ "Return position at which display currently ends in the group of
+windows containing WINDOW. When a grouping mode (such as Follow Mode)
+is not active, this function is identical to `window-end'.
+
+WINDOW must be a live window and defaults to the selected one.
+This is updated by redisplay, when it runs to completion.
+Simply changing the buffer text or setting `window-group-start'
+does not update this value.
+Return nil if there is no recorded value. (This can happen if the
+last redisplay of WINDOW was preempted, and did not finish.)
+If UPDATE is non-nil, compute the up-to-date position
+if it isn't already recorded."
+ (if (functionp window-group-end-function)
+ (funcall window-group-end-function window update)
+ (window-end window update)))
+
+(defvar set-window-group-start-function nil)
+(make-variable-buffer-local 'set-window-group-start-function)
+(put 'set-window-group-start-function 'permanent-local t)
+(defun set-window-group-start (window pos &optional noforce)
+ "Make display in the group of windows containing WINDOW start at
+position POS in WINDOW's buffer. When a grouping mode (such as Follow
+Mode) is not active, this function is identical to `set-window-start'.
+
+WINDOW must be a live window and defaults to the selected one. Return
+POS. Optional third arg NOFORCE non-nil inhibits next redisplay from
+overriding motion of point in order to display at this exact start."
+ (if (functionp set-window-group-start-function)
+ (funcall set-window-group-start-function window pos noforce)
+ (set-window-start window pos noforce)))
+
+(defvar recenter-window-group-function nil)
+(make-variable-buffer-local 'recenter-window-group-function)
+(put 'recenter-window-group-function 'permanent-local t)
+(defun recenter-window-group (&optional arg)
+ "Center point in the group of windows containing the selected window
+and maybe redisplay frame. When a grouping mode (such as Follow Mode)
+is not active, this function is identical to `recenter'.
+
+With a numeric prefix argument ARG, recenter putting point on screen line ARG
+relative to the first window in the selected window group. If ARG is
+negative, it counts up from the bottom of the last window in the
+group. (ARG should be less than the total height of the window group.)
+
+If ARG is omitted or nil, then recenter with point on the middle line of
+the selected window group; if the variable `recenter-redisplay' is
+non-nil, also erase the entire frame and redraw it (when
+`auto-resize-tool-bars' is set to `grow-only', this resets the
+tool-bar's height to the minimum height needed); if
+`recenter-redisplay' has the special value `tty', then only tty frames
+are redrawn.
+
+Just C-u as prefix means put point in the center of the window
+and redisplay normally--don't erase and redraw the frame."
+ (if (functionp recenter-window-group-function)
+ (funcall recenter-window-group-function arg)
+ (recenter arg)))
+
+(defvar pos-visible-in-window-group-p-function nil)
+(make-variable-buffer-local 'pos-visible-in-window-group-p-function)
+(put 'pos-visible-in-window-group-p-function 'permanent-local t)
+(defun pos-visible-in-window-group-p (&optional pos window partially)
+ "Return non-nil if position POS is currently on the frame in the
+window group containing WINDOW. When a grouping mode (such as Follow
+Mode) is not active, this function is identical to
+`pos-visible-in-window-p'.
+
+WINDOW must be a live window and defaults to the selected one.
+
+Return nil if that position is scrolled vertically out of view. If a
+character is only partially visible, nil is returned, unless the
+optional argument PARTIALLY is non-nil. If POS is only out of view
+because of horizontal scrolling, return non-nil. If POS is t, it
+specifies the position of the last visible glyph in the window group.
+POS defaults to point in WINDOW; WINDOW defaults to the selected
+window.
+
+If POS is visible, return t if PARTIALLY is nil; if PARTIALLY is non-nil,
+the return value is a list of 2 or 6 elements (X Y [RTOP RBOT ROWH VPOS]),
+where X and Y are the pixel coordinates relative to the top left corner
+of the window. The remaining elements are omitted if the character after
+POS is fully visible; otherwise, RTOP and RBOT are the number of pixels
+off-window at the top and bottom of the screen line (\"row\") containing
+POS, ROWH is the visible height of that row, and VPOS is the row number
+\(zero-based)."
+ (if (functionp pos-visible-in-window-group-p-function)
+ (funcall pos-visible-in-window-group-p-function pos window partially)
+ (pos-visible-in-window-p pos window partially)))
+
+(defvar selected-window-group-function nil)
+(make-variable-buffer-local 'selected-window-group-function)
+(put 'selected-window-group-function 'permanent-local t)
+(defun selected-window-group ()
+ "Return the list of windows in the group containing the selected window.
+When a grouping mode (such as Follow Mode) is not active, the
+result is a list containing only the selected window."
+ (if (functionp selected-window-group-function)
+ (funcall selected-window-group-function)
+ (list (selected-window))))
+
+(defvar move-to-window-group-line-function nil)
+(make-variable-buffer-local 'move-to-window-group-line-function)
+(put 'move-to-window-group-line-function 'permanent-local t)
+(defun move-to-window-group-line (arg)
+ "Position point relative to the the current group of windows.
+When a grouping mode (such as Follow Mode) is not active, this
+function is identical to `move-to-window-line'.
+
+ARG nil means position point at center of the window group.
+Else, ARG specifies the vertical position within the window
+group; zero means top of first window in the group, negative
+means relative to the bottom of the last window in the group."
+ (if (functionp move-to-window-group-line-function)
+ (funcall move-to-window-group-line-function arg)
+ (move-to-window-line arg)))
+
\f
(defvar recenter-last-op nil
"Indicates the last recenter operation performed.
a two-argument function used to combine the widths and heights of
the given windows."
(when windows
- (let ((width (window-body-width (car windows)))
+ (let ((width (window-max-chars-per-line (car windows)))
(height (window-body-height (car windows))))
(dolist (window (cdr windows))
- (setf width (funcall reducer width (window-body-width window)))
+ (setf width (funcall reducer width (window-max-chars-per-line window)))
(setf height (funcall reducer height (window-body-height window))))
(cons width height))))
displaying that processes's buffer."
(let ((processes (process-list))
(process-windows nil))
- (walk-windows
- (lambda (window)
- (let ((buffer (window-buffer window))
- (iter processes))
- (while (let ((process (car iter)))
- (if (and (process-live-p process)
- (eq buffer (process-buffer process)))
- (let ((procwin (assq process process-windows)))
- ;; Add this window to the list of windows
- ;; displaying process.
- (if procwin
- (push window (cdr procwin))
- (push (list process window) process-windows))
- ;; We found our process for this window, so
- ;; stop iterating over the process list.
- nil)
- (setf iter (cdr iter)))))))
- 1 t)
+ (if processes
+ (walk-windows
+ (lambda (window)
+ (let ((buffer (window-buffer window))
+ (iter processes))
+ (while (let ((process (car iter)))
+ (if (and (process-live-p process)
+ (eq buffer (process-buffer process)))
+ (let ((procwin (assq process process-windows)))
+ ;; Add this window to the list of windows
+ ;; displaying process.
+ (if procwin
+ (push window (cdr procwin))
+ (push (list process window) process-windows))
+ ;; We found our process for this window, so
+ ;; stop iterating over the process list.
+ nil)
+ (setf iter (cdr iter)))))))
+ 1 t))
process-windows))
(defun window--adjust-process-windows ()
"Update process window sizes to match the current window configuration."
- (dolist (procwin (window--process-window-list))
- (let ((process (car procwin)))
- (with-demoted-errors "Error adjusting window size: %S"
- (with-current-buffer (process-buffer process)
- (let ((size (funcall
- (or (process-get process 'adjust-window-size-function)
- window-adjust-process-window-size-function)
- process (cdr procwin))))
- (when size
- (set-process-window-size process (cdr size) (car size)))))))))
+ (when (fboundp 'process-list)
+ (dolist (procwin (window--process-window-list))
+ (let ((process (car procwin)))
+ (with-demoted-errors "Error adjusting window size: %S"
+ (with-current-buffer (process-buffer process)
+ (let ((size (funcall
+ (or (process-get process 'adjust-window-size-function)
+ window-adjust-process-window-size-function)
+ process (cdr procwin))))
+ (when size
+ (set-process-window-size process (cdr size) (car size))))))))))
(add-hook 'window-configuration-change-hook 'window--adjust-process-windows)