X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/64c57303658f69b019c4599f8c960a5623855410..9a8edcd9aba1650f68d7aea373bab65322585337:/lisp/window.el diff --git a/lisp/window.el b/lisp/window.el index c5a1019372..a0bdfeb672 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,6 +1,6 @@ ;;; 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 @@ -28,17 +28,6 @@ ;;; Code: -(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)))) - (defun internal--before-save-selected-window () (cons (selected-window) ;; We save and restore all frames' selected windows, because @@ -1900,9 +1889,19 @@ the font." (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) @@ -2016,7 +2015,7 @@ SIDE can be any of the symbols `left', `top', `right' or ;; 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) @@ -2045,7 +2044,7 @@ has one, and a window at the bottom of the frame otherwise. 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)) @@ -2484,8 +2483,6 @@ windows." (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 @@ -3252,9 +3249,9 @@ move it as far as possible in the desired direction." (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 @@ -3349,20 +3346,29 @@ negative, shrink selected window by -DELTA lines or columns." (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) @@ -3375,8 +3381,7 @@ negative, shrink selected window by -DELTA lines or columns." 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) @@ -3384,20 +3389,29 @@ Also see the `window-min-height' variable." (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) @@ -6732,6 +6746,71 @@ that frame." (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 @@ -7068,7 +7147,7 @@ buffer with the name BUFFER-OR-NAME and return that buffer." 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 @@ -7086,7 +7165,7 @@ the selected window or never appeared in it before, or if (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. @@ -7880,6 +7959,152 @@ Return non-nil if the window was shrunk, nil otherwise." (with-current-buffer buffer-to-kill (remove-hook 'kill-buffer-hook delete-window-hook t)))))) + +;;; +;; 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))) + (defvar recenter-last-op nil "Indicates the last recenter operation performed. @@ -8335,10 +8560,10 @@ WINDOWS is a list of windows associated with PROCESS. REDUCER is 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)))) @@ -8360,38 +8585,40 @@ A window is associated with a process if that window is 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)