X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6dc3311d252c4f85ab7ba93dfef6486afa2fbd5b..96ae4c8fa704b0385d6f2cf10b69bf289e2fb7ef:/lisp/window.el diff --git a/lisp/window.el b/lisp/window.el index a4931d446a..2f6c64ba3d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,10 +1,12 @@ ;;; window.el --- GNU Emacs window commands aside from those written in C ;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -76,9 +78,9 @@ WINDOW defaults to the selected window. The return value does not include the mode line or the header line, if any. If a line at the bottom of the window is only -partially visible, that line is included in the return value. If -you do not want to include a partially visible bottom line in the -return value, use `window-text-height' instead." +partially visible, that line is included in the return value. +If you do not want to include a partially visible bottom line +in the return value, use `window-text-height' instead." (or window (setq window (selected-window))) (if (window-minibuffer-p window) (window-height window) @@ -87,6 +89,16 @@ return value, use `window-text-height' instead." (if mode-line-format 1 0) (if header-line-format 1 0)))))) +;; See discussion in bug#4543. +(defun window-full-height-p (&optional window) + "Return non-nil if WINDOW is not the result of a vertical split. +WINDOW defaults to the selected window. (This function is not +appropriate for minibuffers.)" + (unless window + (setq window (selected-window))) + (= (window-height window) + (window-height (frame-root-window (window-frame window))))) + (defun one-window-p (&optional nomini all-frames) "Return non-nil if the selected window is the only window. Optional arg NOMINI non-nil means don't count the minibuffer @@ -591,8 +603,6 @@ and `same-window-regexps'. Those variables take precedence over this one. See also `special-display-regexps'." - ;; Autoload if this file no longer dumped. - :risky t :type '(repeat (choice :tag "Buffer" :value "" @@ -614,6 +624,9 @@ See also `special-display-regexps'." :group 'windows :group 'frames) +;;;###autoload +(put 'special-display-buffer-names 'risky-local-variable t) + (defcustom special-display-regexps nil "List of regexps saying which buffers should be displayed specially. Displaying a buffer with `display-buffer' or `pop-to-buffer', if @@ -773,7 +786,7 @@ selected rather than \(as usual\) some other window. See (defcustom pop-up-frames nil "Whether `display-buffer' should make a separate frame. -If nil, never make a seperate frame. +If nil, never make a separate frame. If the value is `graphic-only', make a separate frame on graphic displays only. Any other non-nil value means always make a separate frame." @@ -994,7 +1007,7 @@ is higher than WINDOW." (not (eq window (selected-window))) ;; Don't resize minibuffer windows. (not (window-minibuffer-p (selected-window))) - (> (window-height (selected-window)) (window-height window)) + (> (window-height (selected-window)) (window-height window)) (eq (window-frame window) (window-frame (selected-window))) (let ((sel-edges (window-edges (selected-window))) (win-edges (window-edges window))) @@ -1024,13 +1037,21 @@ Do not raise the selected frame. Return WINDOW." (raise-frame frame)) window)) -(defun window--display-buffer-2 (buffer window) +(defun window--display-buffer-2 (buffer window &optional dedicated) "Display BUFFER in WINDOW and make its frame visible. +Set `window-dedicated-p' to DEDICATED if non-nil. Return WINDOW." (when (and (buffer-live-p buffer) (window-live-p window)) (set-window-buffer window buffer) + (when dedicated + (set-window-dedicated-p window dedicated)) (window--display-buffer-1 window))) +(defvar display-buffer-mark-dedicated nil + "If non-nil, `display-buffer' marks the windows it creates as dedicated. +The actual non-nil value of this variable will be copied to the +`window-dedicated-p' flag.") + (defun display-buffer (buffer-or-name &optional not-this-window frame) "Make buffer BUFFER-OR-NAME appear in some window but don't select it. BUFFER-OR-NAME must be a buffer or the name of an existing @@ -1122,8 +1143,8 @@ consider all visible or iconified frames." buffer (if (listp pars) pars)))))) ((or use-pop-up-frames (not frame-to-use)) ;; We want or need a new frame. - (window--display-buffer-2 - buffer (frame-selected-window (funcall pop-up-frame-function)))) + (let ((win (frame-selected-window (funcall pop-up-frame-function)))) + (window--display-buffer-2 buffer win display-buffer-mark-dedicated))) ((and pop-up-windows ;; Make a new window. (or (not (frame-parameter frame-to-use 'unsplittable)) @@ -1138,8 +1159,9 @@ consider all visible or iconified frames." (or (window--try-to-split-window (get-largest-window frame-to-use t)) (window--try-to-split-window - (get-lru-window frame-to-use t)))) - (window--display-buffer-2 buffer window-to-use))) + (get-lru-window frame-to-use t))))) + (window--display-buffer-2 buffer window-to-use + display-buffer-mark-dedicated)) ((let ((window-to-undedicate ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate ;; the selected window to its buffer, to avoid that some of @@ -1199,19 +1221,16 @@ at the front of the list of recently selected ones." (let ((buf (get-buffer-create buffer-or-name))) (set-buffer-major-mode buf) buf)))) - (old-window (selected-window)) (old-frame (selected-frame)) new-window new-frame) (set-buffer buffer) (setq new-window (display-buffer buffer other-window)) - (unless (eq new-window old-window) - ;; `display-buffer' has chosen another window, select it. - (select-window new-window norecord) - (setq new-frame (window-frame new-window)) - (unless (eq new-frame old-frame) - ;; `display-buffer' has chosen another frame, make sure it gets - ;; input focus and is risen. - (select-frame-set-input-focus new-frame))) + (select-window new-window norecord) + (setq new-frame (window-frame new-window)) + (unless (eq new-frame old-frame) + ;; `display-buffer' has chosen another frame, make sure it gets + ;; input focus and is risen. + (select-frame-set-input-focus new-frame)) buffer)) ;; I think this should be the default; I think people will prefer it--rms. @@ -1259,8 +1278,7 @@ window." (setq size (+ (window-height) size))) (setq new-window (split-window nil size)) (unless split-window-keep-point - (save-excursion - (set-buffer (window-buffer)) + (with-current-buffer (window-buffer) (goto-char (window-start)) (setq moved (vertical-motion (window-height))) (set-window-start new-window (point)) @@ -1597,42 +1615,246 @@ Otherwise, bury WINDOW's buffer, see `bury-buffer'." (kill-buffer buffer) (bury-buffer buffer)))) + (defvar recenter-last-op nil "Indicates the last recenter operation performed. -Possible values: `top', `middle', `bottom'.") +Possible values: `top', `middle', `bottom', integer or float numbers.") + +(defcustom recenter-positions '(middle top bottom) + "Cycling order for `recenter-top-bottom'. +A list of elements with possible values `top', `middle', `bottom', +integer or float numbers that define the cycling order for +the command `recenter-top-bottom'. + +Top and bottom destinations are `scroll-margin' lines the from true +window top and bottom. Middle redraws the frame and centers point +vertically within the window. Integer number moves current line to +the specified absolute window-line. Float number between 0.0 and 1.0 +means the percentage of the screen space from the top. The default +cycling order is middle -> top -> bottom." + :type '(repeat (choice + (const :tag "Top" top) + (const :tag "Middle" middle) + (const :tag "Bottom" bottom) + (integer :tag "Line number") + (float :tag "Percentage"))) + :version "23.2" + :group 'windows) (defun recenter-top-bottom (&optional arg) - "Move current line to window center, top, and bottom, successively. -With no prefix argument, the first call redraws the frame and - centers point vertically within the window. Successive calls - scroll the window, placing point on the top, bottom, and middle - consecutively. The cycling order is middle -> top -> bottom. + "Move current buffer line to the specified window line. +With no prefix argument, successive calls place point according +to the cycling order defined by `recenter-positions'. A prefix argument is handled like `recenter': With numeric prefix ARG, move current line to window-line ARG. - With plain `C-u', move current line to window center. - -Top and bottom destinations are actually `scroll-margin' lines - the from true window top and bottom." + With plain `C-u', move current line to window center." (interactive "P") (cond - (arg (recenter arg)) ; Always respect ARG. - ((or (not (eq this-command last-command)) - (eq recenter-last-op 'bottom)) - (setq recenter-last-op 'middle) - (recenter)) + (arg (recenter arg)) ; Always respect ARG. (t + (setq recenter-last-op + (if (eq this-command last-command) + (car (or (cdr (member recenter-last-op recenter-positions)) + recenter-positions)) + (car recenter-positions))) (let ((this-scroll-margin (min (max 0 scroll-margin) (truncate (/ (window-body-height) 4.0))))) (cond ((eq recenter-last-op 'middle) - (setq recenter-last-op 'top) - (recenter this-scroll-margin)) + (recenter)) ((eq recenter-last-op 'top) - (setq recenter-last-op 'bottom) - (recenter (- -1 this-scroll-margin)))))))) + (recenter this-scroll-margin)) + ((eq recenter-last-op 'bottom) + (recenter (- -1 this-scroll-margin))) + ((integerp recenter-last-op) + (recenter recenter-last-op)) + ((floatp recenter-last-op) + (recenter (round (* recenter-last-op (window-height)))))))))) (define-key global-map [?\C-l] 'recenter-top-bottom) + +(defun move-to-window-line-top-bottom (&optional arg) + "Position point relative to window. + +With a prefix argument ARG, acts like `move-to-window-line'. + +With no argument, positions point at center of window. +Successive calls position point at positions defined +by `recenter-positions'." + (interactive "P") + (cond + (arg (move-to-window-line arg)) ; Always respect ARG. + (t + (setq recenter-last-op + (if (eq this-command last-command) + (car (or (cdr (member recenter-last-op recenter-positions)) + recenter-positions)) + (car recenter-positions))) + (let ((this-scroll-margin + (min (max 0 scroll-margin) + (truncate (/ (window-body-height) 4.0))))) + (cond ((eq recenter-last-op 'middle) + (call-interactively 'move-to-window-line)) + ((eq recenter-last-op 'top) + (move-to-window-line this-scroll-margin)) + ((eq recenter-last-op 'bottom) + (move-to-window-line (- -1 this-scroll-margin))) + ((integerp recenter-last-op) + (move-to-window-line recenter-last-op)) + ((floatp recenter-last-op) + (move-to-window-line (round (* recenter-last-op (window-height)))))))))) + +(define-key global-map [?\M-r] 'move-to-window-line-top-bottom) + + +;;; Scrolling commands. + +;;; Scrolling commands which does not signal errors at top/bottom +;;; of buffer at first key-press (instead moves to top/bottom +;;; of buffer). + +(defcustom scroll-error-top-bottom nil + "Move point to top/bottom of buffer before signalling a scrolling error. +A value of nil means just signal an error if no more scrolling possible. +A value of t means point moves to the beginning or the end of the buffer +\(depending on scrolling direction) when no more scrolling possible. +When point is already on that position, then signal an error." + :type 'boolean + :group 'scrolling + :version "24.1") + +(defun scroll-up-command (&optional arg) + "Scroll text of selected window upward ARG lines; or near full screen if no ARG. +If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot +scroll window further, move cursor to the bottom line. +When point is already on that position, then signal an error. +A near full screen is `next-screen-context-lines' less than a full screen. +Negative ARG means scroll downward. +If ARG is the atom `-', scroll downward by nearly full screen." + (interactive "^P") + (cond + ((null scroll-error-top-bottom) + (scroll-up arg)) + ((eq arg '-) + (scroll-down-command nil)) + ((< (prefix-numeric-value arg) 0) + (scroll-down-command (- (prefix-numeric-value arg)))) + ((eobp) + (scroll-up arg)) ; signal error + (t + (condition-case nil + (scroll-up arg) + (end-of-buffer + (if arg + ;; When scrolling by ARG lines can't be done, + ;; move by ARG lines instead. + (forward-line arg) + ;; When ARG is nil for full-screen scrolling, + ;; move to the bottom of the buffer. + (goto-char (point-max)))))))) + +(put 'scroll-up-command 'scroll-command t) + +(defun scroll-down-command (&optional arg) + "Scroll text of selected window down ARG lines; or near full screen if no ARG. +If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot +scroll window further, move cursor to the top line. +When point is already on that position, then signal an error. +A near full screen is `next-screen-context-lines' less than a full screen. +Negative ARG means scroll upward. +If ARG is the atom `-', scroll upward by nearly full screen." + (interactive "^P") + (cond + ((null scroll-error-top-bottom) + (scroll-down arg)) + ((eq arg '-) + (scroll-up-command nil)) + ((< (prefix-numeric-value arg) 0) + (scroll-up-command (- (prefix-numeric-value arg)))) + ((bobp) + (scroll-down arg)) ; signal error + (t + (condition-case nil + (scroll-down arg) + (beginning-of-buffer + (if arg + ;; When scrolling by ARG lines can't be done, + ;; move by ARG lines instead. + (forward-line (- arg)) + ;; When ARG is nil for full-screen scrolling, + ;; move to the top of the buffer. + (goto-char (point-min)))))))) + +(put 'scroll-down-command 'scroll-command t) + +;;; Scrolling commands which scroll a line instead of full screen. + +(defun scroll-up-line (&optional arg) + "Scroll text of selected window upward ARG lines; or one line if no ARG. +If ARG is omitted or nil, scroll upward by one line. +This is different from `scroll-up-command' that scrolls a full screen." + (interactive "p") + (scroll-up (or arg 1))) + +(put 'scroll-up-line 'scroll-command t) + +(defun scroll-down-line (&optional arg) + "Scroll text of selected window down ARG lines; or one line if no ARG. +If ARG is omitted or nil, scroll down by one line. +This is different from `scroll-down-command' that scrolls a full screen." + (interactive "p") + (scroll-down (or arg 1))) + +(put 'scroll-down-line 'scroll-command t) + + +(defun scroll-other-window-down (lines) + "Scroll the \"other window\" down. +For more details, see the documentation for `scroll-other-window'." + (interactive "P") + (scroll-other-window + ;; Just invert the argument's meaning. + ;; We can do that without knowing which window it will be. + (if (eq lines '-) nil + (if (null lines) '- + (- (prefix-numeric-value lines)))))) + +(defun beginning-of-buffer-other-window (arg) + "Move point to the beginning of the buffer in the other window. +Leave mark at previous position. +With arg N, put point N/10 of the way from the true beginning." + (interactive "P") + (let ((orig-window (selected-window)) + (window (other-window-for-scrolling))) + ;; We use unwind-protect rather than save-window-excursion + ;; because the latter would preserve the things we want to change. + (unwind-protect + (progn + (select-window window) + ;; Set point and mark in that window's buffer. + (with-no-warnings + (beginning-of-buffer arg)) + ;; Set point accordingly. + (recenter '(t))) + (select-window orig-window)))) + +(defun end-of-buffer-other-window (arg) + "Move point to the end of the buffer in the other window. +Leave mark at previous position. +With arg N, put point N/10 of the way from the true end." + (interactive "P") + ;; See beginning-of-buffer-other-window for comments. + (let ((orig-window (selected-window)) + (window (other-window-for-scrolling))) + (unwind-protect + (progn + (select-window window) + (with-no-warnings + (end-of-buffer arg)) + (recenter '(t))) + (select-window orig-window)))) + (defvar mouse-autoselect-window-timer nil "Timer used by delayed window autoselection.")