X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/492878e483c355e6851d72cb4e395f069cd02964..96439b6aabaca49a1fb43bf5d526e82f12b0924b:/lisp/window.el diff --git a/lisp/window.el b/lisp/window.el index 25d90e777c..5be9f870b9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,5 +1,8 @@ -;;; windows.el --- GNU Emacs window commands aside from those written in C. -;;; Copyright (C) 1985, 1989, 1992 Free Software Foundation, Inc. +;;; window.el --- GNU Emacs window commands aside from those written in C. + +;; Copyright (C) 1985, 1989, 1992, 1993, 1994 Free Software Foundation, Inc. + +;; Maintainer: FSF ;; This file is part of GNU Emacs. @@ -14,45 +17,143 @@ ;; GNU General Public License for more details. ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; 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. + +;;; Code: + +;;;; Window tree functions. + +(defun one-window-p (&optional nomini all-frames) + "Returns non-nil if the selected window is the only window (in its frame). +Optional arg NOMINI non-nil means don't count the minibuffer +even if it is active. + +The optional arg ALL-FRAMES t means count windows on all frames. +If it is `visible', count windows on all visible frames. +ALL-FRAMES nil or omitted means count only the selected frame, +plus the minibuffer it uses (which may be on another frame). +If ALL-FRAMES is neither nil nor t, count only the selected frame." + (let ((base-window (selected-window))) + (if (and nomini (eq base-window (minibuffer-window))) + (setq base-window (next-window base-window))) + (eq base-window + (next-window base-window (if nomini 'arg) all-frames)))) + +(defun walk-windows (proc &optional minibuf all-frames) + "Cycle through all visible windows, calling PROC for each one. +PROC is called with a window as argument. + +Optional second arg MINIBUF t means count the minibuffer window even +if not active. MINIBUF nil or omitted means count the minibuffer iff +it is active. MINIBUF neither t nor nil means not to count the +minibuffer even if it is active. + +Several frames may share a single minibuffer; if the minibuffer +counts, all windows on all frames that share that minibuffer count +too. Therefore, if you are using a separate minibuffer frame +and the minibuffer is active and MINIBUF says it counts, +`walk-windows' includes the windows in the frame from which you +entered the minibuffer, as well as the minibuffer window. + +ALL-FRAMES is the optional third argument. +ALL-FRAMES nil or omitted means cycle within the frames as specified above. +ALL-FRAMES = `visible' means include windows on all visible frames. +ALL-FRAMES = 0 means include windows on all visible and iconified frames. +ALL-FRAMES = t means include windows on all frames including invisible frames. +Anything else means restrict to the selected frame." + ;; If we start from the minibuffer window, don't fail to come back to it. + (if (window-minibuffer-p (selected-window)) + (setq minibuf t)) + (let* ((walk-windows-start (selected-window)) + (walk-windows-current walk-windows-start)) + (while (progn + (setq walk-windows-current + (next-window walk-windows-current minibuf all-frames)) + (funcall proc walk-windows-current) + (not (eq walk-windows-current walk-windows-start)))))) +(defun minibuffer-window-active-p (window) + "Return t if WINDOW (a minibuffer window) is now active." + (eq window (active-minibuffer-window))) +(defmacro save-selected-window (&rest body) + "Execute BODY, then select the window that was selected before BODY." + (list 'let + '((save-selected-window-window (selected-window))) + (list 'unwind-protect + (cons 'progn body) + (list 'select-window 'save-selected-window-window)))) + (defun count-windows (&optional minibuf) "Returns the number of visible windows. -Optional arg NO-MINI non-nil means don't count the minibuffer -even if it is active." +Optional arg MINIBUF non-nil means count the minibuffer +even if it is inactive." (let ((count 0)) - (walk-windows (function (lambda () + (walk-windows (function (lambda (w) (setq count (+ count 1)))) minibuf) count)) (defun balance-windows () - "Makes all visible windows the same size (approximately)." + "Makes all visible windows the same height (approximately)." (interactive) - (let ((count 0)) - (walk-windows (function (lambda (w) - (setq count (+ count 1)))) + (let ((count -1) levels newsizes 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)))))) + ;; Find all the different vpos's at which windows start, + ;; then count them. But ignore levels that differ by only 1. + (save-window-excursion + (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 that many vertical levels. + (setq size (/ (- (frame-height) mbl) count)) + (walk-windows (function + (lambda (w) + (select-window w) + (let ((newtop (cdr (assq (nth 1 (window-edges)) + levels))) + (newbot (or (cdr (assq (+ (window-height) + (nth 1 (window-edges))) + levels)) + count))) + (setq newsizes + (cons (cons w (* size (- newbot newtop))) + newsizes))))) 'nomini) - (let ((size (/ (screen-height) count))) - (walk-windows (function (lambda (w) - (select-window w) - (enlarge-window (- size (window-height))))) - 'nomini)))) - + (walk-windows (function (lambda (w) + (select-window w) + (let ((newsize (cdr (assq w newsizes)))) + (enlarge-window (- newsize + (window-height)))))) + 'nomini))) + ;;; I think this should be the default; I think people will prefer it--rms. - -(defvar split-window-keep-point t - "*If non-nil, split windows so that both windows keep the original -value of point. This is often more convenient for editing. -If nil, split windows to minimize redisplay. This is convenient on -slow terminals, but point may be moved strangely to accommodate the -redisplay.") +(defcustom split-window-keep-point t + "*If non-nil, split windows keeps the original point in both children. +This is often more convenient for editing. +If nil, adjust point in each of the two windows to minimize redisplay. +This is convenient on slow terminals, but point can move strangely." + :type 'boolean + :group 'windows) (defun split-window-vertically (&optional arg) "Split current window into two windows, one above the other. The uppermost window gets ARG lines and the other gets the rest. +Negative arg means select the size of the lowermost window instead. With no argument, split equally or close to it. Both windows display the same buffer now current. @@ -68,33 +169,46 @@ new mode line." (interactive "P") (let ((old-w (selected-window)) (old-point (point)) - new-w bottom switch) - (setq new-w (split-window nil (and arg (prefix-numeric-value arg)))) + (size (and arg (prefix-numeric-value arg))) + (window-full-p nil) + new-w bottom switch moved) + (and size (< size 0) (setq size (+ (window-height) size))) + (setq new-w (split-window nil size)) (or split-window-keep-point (progn (save-excursion (set-buffer (window-buffer)) (goto-char (window-start)) - (vertical-motion (window-height)) + (setq moved (vertical-motion (window-height))) (set-window-start new-w (point)) (if (> (point) (window-point new-w)) (set-window-point new-w (point))) - (vertical-motion -1) - (setq bottom (point))) - (if (<= bottom (point)) - (set-window-point old-w (1- bottom))) - (if (< (window-start new-w) old-point) - (progn - (set-window-point new-w old-point) - (select-window new-w))))))) + (and (= moved (window-height)) + (progn + (setq window-full-p t) + (vertical-motion -1))) + (setq bottom (point))) + (and window-full-p + (<= bottom (point)) + (set-window-point old-w (1- bottom))) + (and window-full-p + (<= (window-start new-w) old-point) + (progn + (set-window-point new-w old-point) + (select-window new-w))))) + new-w)) (defun split-window-horizontally (&optional arg) "Split current window into two windows side by side. -This window becomes the leftmost of the two, and gets -ARG columns. No arg means split equally." +This window becomes the leftmost of the two, and gets ARG columns. +Negative arg means select the size of the rightmost window instead. +No arg means split equally." (interactive "P") - (split-window nil (and arg (prefix-numeric-value arg)) t)) - + (let ((size (and arg (prefix-numeric-value arg)))) + (and size (< size 0) + (setq size (+ (window-width) size))) + (split-window nil size t))) + (defun enlarge-window-horizontally (arg) "Make current window ARG columns wider." (interactive "p") @@ -105,23 +219,82 @@ ARG columns. No arg means split equally." (interactive "p") (shrink-window arg t)) -(defun window-config-to-register (name) - "Save the current window configuration in register REG (a letter). -It can be later retrieved using \\[M-x register-to-window-config]." - (interactive "cSave window configuration in register: ") - (set-register name (current-window-configuration))) +(defun shrink-window-if-larger-than-buffer (&optional window) + "Shrink the WINDOW to be as small as possible to display its contents. +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 the window is not the full width of the frame, +or if the window is the only window of its frame." + (interactive) + (or window (setq window (selected-window))) + (save-excursion + (set-buffer (window-buffer window)) + (let* ((w (selected-window)) ;save-window-excursion can't win + (buffer-file-name buffer-file-name) + (p (point)) + (n 0) + (ignore-final-newline + ;; If buffer ends with a newline, ignore it when counting height + ;; unless point is after it. + (and (not (eobp)) + (eq ?\n (char-after (1- (point-max)))))) + (buffer-read-only nil) + (modified (buffer-modified-p)) + (buffer (current-buffer)) + (params (frame-parameters (window-frame window))) + (mini (cdr (assq 'minibuffer params))) + (edges (window-edges (selected-window)))) + (if (and (< 1 (let ((frame (selected-frame))) + (select-frame (window-frame window)) + (unwind-protect + (count-windows) + (select-frame frame)))) + (= (window-width window) (frame-width (window-frame window))) + (pos-visible-in-window-p (point-min) window) + (not (eq mini 'only)) + (or (not mini) + (< (nth 3 edges) + (nth 1 (window-edges mini))) + (> (nth 1 edges) + (cdr (assq 'menu-bar-lines params))))) + (unwind-protect + (progn + (select-window (or window w)) + (goto-char (point-min)) + (while (pos-visible-in-window-p + (- (point-max) + (if ignore-final-newline 1 0))) + ;; defeat file locking... don't try this at home, kids! + (setq buffer-file-name nil) + (insert ?\n) (setq n (1+ n))) + (if (> n 0) + (shrink-window (min (1- n) + (- (window-height) + window-min-height))))) + (delete-region (point-min) (point)) + (set-buffer-modified-p modified) + (goto-char p) + (select-window w) + ;; Make sure we unbind buffer-read-only + ;; with the proper current buffer. + (set-buffer buffer)))))) -(defun register-to-window-config (name) - "Restore (make current) the window configuration in register REG (a letter). -Use with a register previously set with \\[window-config-to-register]." - (interactive "cRestore window configuration from register: ") - (set-window-configuration (get-register name))) +(defun kill-buffer-and-window () + "Kill the current buffer and delete the selected window." + (interactive) + (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name))) + (let ((buffer (current-buffer))) + (delete-window (selected-window)) + (kill-buffer buffer)) + (error "Aborted"))) (define-key ctl-x-map "2" 'split-window-vertically) (define-key ctl-x-map "3" 'split-window-horizontally) -(define-key ctl-x-map "6" 'window-config-to-register) -(define-key ctl-x-map "7" 'register-to-window-config) (define-key ctl-x-map "}" 'enlarge-window-horizontally) (define-key ctl-x-map "{" 'shrink-window-horizontally) +(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer) +(define-key ctl-x-map "+" 'balance-windows) +(define-key ctl-x-4-map "0" 'kill-buffer-and-window) ;;; windows.el ends here