aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/window.el
diff options
context:
space:
mode:
authorBastien2017-07-03 09:06:29 +0200
committerBastien2017-07-03 09:06:29 +0200
commit5ca1888fe670aee7febd4d42665d7372ab2ffebc (patch)
tree1f7f8d8a7580e556fc83cf3a6aaeec567b33a090 /lisp/window.el
parent20e006ffee41062f1b551a92c24d9edc53cd0f56 (diff)
parent1b4f0a92ff3505ef9a465b9b391756e3a73a6443 (diff)
downloademacs-5ca1888fe670aee7febd4d42665d7372ab2ffebc.tar.gz
emacs-5ca1888fe670aee7febd4d42665d7372ab2ffebc.zip
Merge branch 'master' into scratch/org-mode-merge
Diffstat (limited to 'lisp/window.el')
-rw-r--r--lisp/window.el615
1 files changed, 418 insertions, 197 deletions
diff --git a/lisp/window.el b/lisp/window.el
index 8b07ed462c9..c933996a72f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -3703,7 +3703,7 @@ are one more than the actual value of these edges. Note that if
3703ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too." 3703ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
3704 (let* ((window (window-normalize-window window body)) 3704 (let* ((window (window-normalize-window window body))
3705 (frame (window-frame window)) 3705 (frame (window-frame window))
3706 (border-width (frame-border-width frame)) 3706 (border-width (frame-internal-border-width frame))
3707 (char-width (frame-char-width frame)) 3707 (char-width (frame-char-width frame))
3708 (char-height (frame-char-height frame)) 3708 (char-height (frame-char-height frame))
3709 (left (if pixelwise 3709 (left (if pixelwise
@@ -4572,12 +4572,13 @@ The function is called with one argument - a frame.
4572Functions affected by this option are those that bury a buffer 4572Functions affected by this option are those that bury a buffer
4573shown in a separate frame like `quit-window' and `bury-buffer'." 4573shown in a separate frame like `quit-window' and `bury-buffer'."
4574 :type '(choice (const :tag "Iconify" iconify-frame) 4574 :type '(choice (const :tag "Iconify" iconify-frame)
4575 (const :tag "Make invisible" make-frame-invisible)
4575 (const :tag "Delete" delete-frame) 4576 (const :tag "Delete" delete-frame)
4576 (const :tag "Do nothing" ignore) 4577 (const :tag "Do nothing" ignore)
4577 function) 4578 function)
4578 :group 'windows 4579 :group 'windows
4579 :group 'frames 4580 :group 'frames
4580 :version "24.1") 4581 :version "26.1")
4581 4582
4582(defun window--delete (&optional window dedicated-only kill) 4583(defun window--delete (&optional window dedicated-only kill)
4583 "Delete WINDOW if possible. 4584 "Delete WINDOW if possible.
@@ -4595,7 +4596,9 @@ if WINDOW gets deleted or its frame is auto-hidden."
4595 (cond 4596 (cond
4596 (kill 4597 (kill
4597 (delete-frame frame)) 4598 (delete-frame frame))
4598 ((functionp frame-auto-hide-function) 4599 ((functionp (frame-parameter frame 'auto-hide-function))
4600 (funcall (frame-parameter frame 'auto-hide-function)))
4601 ((functionp frame-auto-hide-function)
4599 (funcall frame-auto-hide-function frame)))) 4602 (funcall frame-auto-hide-function frame))))
4600 'frame) 4603 'frame)
4601 (deletable 4604 (deletable
@@ -6734,15 +6737,17 @@ live."
6734 window)) 6737 window))
6735 6738
6736(defun window--maybe-raise-frame (frame) 6739(defun window--maybe-raise-frame (frame)
6737 (let ((visible (frame-visible-p frame))) 6740 (make-frame-visible frame)
6738 (unless (or (not visible) 6741 (unless (or (frame-parameter frame 'no-focus-on-map)
6739 ;; Assume the selected frame is already visible enough. 6742 ;; Don't raise frames that should not get focus.
6740 (eq frame (selected-frame)) 6743 (frame-parameter frame 'no-accept-focus)
6741 ;; Assume the frame from which we invoked the 6744 ;; Assume the selected frame is already visible enough.
6742 ;; minibuffer is visible. 6745 (eq frame (selected-frame))
6743 (and (minibuffer-window-active-p (selected-window)) 6746 ;; Assume the frame from which we invoked the
6744 (eq frame (window-frame (minibuffer-selected-window))))) 6747 ;; minibuffer is visible.
6745 (raise-frame frame)))) 6748 (and (minibuffer-window-active-p (selected-window))
6749 (eq frame (window-frame (minibuffer-selected-window)))))
6750 (raise-frame frame)))
6746 6751
6747;; FIXME: Not implemented. 6752;; FIXME: Not implemented.
6748;; FIXME: By the way, there could be more levels of dedication: 6753;; FIXME: By the way, there could be more levels of dedication:
@@ -6762,6 +6767,7 @@ The actual non-nil value of this variable will be copied to the
6762 (const display-buffer-pop-up-window) 6767 (const display-buffer-pop-up-window)
6763 (const display-buffer-same-window) 6768 (const display-buffer-same-window)
6764 (const display-buffer-pop-up-frame) 6769 (const display-buffer-pop-up-frame)
6770 (const display-buffer-in-child-frame)
6765 (const display-buffer-below-selected) 6771 (const display-buffer-below-selected)
6766 (const display-buffer-at-bottom) 6772 (const display-buffer-at-bottom)
6767 (const display-buffer-in-previous-window) 6773 (const display-buffer-in-previous-window)
@@ -6908,6 +6914,7 @@ Available action functions include:
6908 `display-buffer-same-window' 6914 `display-buffer-same-window'
6909 `display-buffer-reuse-window' 6915 `display-buffer-reuse-window'
6910 `display-buffer-pop-up-frame' 6916 `display-buffer-pop-up-frame'
6917 `display-buffer-in-child-frame'
6911 `display-buffer-pop-up-window' 6918 `display-buffer-pop-up-window'
6912 `display-buffer-in-previous-window' 6919 `display-buffer-in-previous-window'
6913 `display-buffer-use-some-window' 6920 `display-buffer-use-some-window'
@@ -7239,6 +7246,7 @@ raising the frame."
7239 (get-largest-window frame t) alist) 7246 (get-largest-window frame t) alist)
7240 (window--try-to-split-window 7247 (window--try-to-split-window
7241 (get-lru-window frame t) alist)))) 7248 (get-lru-window frame t) alist))))
7249
7242 (prog1 (window--display-buffer 7250 (prog1 (window--display-buffer
7243 buffer window 'window alist display-buffer-mark-dedicated) 7251 buffer window 'window alist display-buffer-mark-dedicated)
7244 (unless (cdr (assq 'inhibit-switch-frame alist)) 7252 (unless (cdr (assq 'inhibit-switch-frame alist))
@@ -7258,6 +7266,47 @@ again with `display-buffer-pop-up-window'."
7258 (and pop-up-windows 7266 (and pop-up-windows
7259 (display-buffer-pop-up-window buffer alist)))) 7267 (display-buffer-pop-up-window buffer alist))))
7260 7268
7269(defun display-buffer-in-child-frame (buffer alist)
7270 "Display BUFFER in a child frame.
7271By default, this either reuses a child frame of the selected
7272frame or makes a new child frame of the selected frame. If
7273successful, return the window used; otherwise return nil.
7274
7275If ALIST has a non-nil 'child-frame-parameters' entry, the
7276corresponding value is an alist of frame parameters to give the
7277new frame. A 'parent-frame' parameter specifying the selected
7278frame is provided by default. If the child frame should be or
7279become the child of any other frame, a corresponding entry must
7280be added to ALIST."
7281 (let* ((parameters
7282 (append
7283 (cdr (assq 'child-frame-parameters alist))
7284 `((parent-frame . ,(selected-frame)))))
7285 (parent (or (assq 'parent-frame parameters)
7286 (selected-frame)))
7287 (share (assq 'share-child-frame parameters))
7288 share1 frame window)
7289 (with-current-buffer buffer
7290 (when (frame-live-p parent)
7291 (catch 'frame
7292 (dolist (frame1 (frame-list))
7293 (when (eq (frame-parent frame1) parent)
7294 (setq share1 (assq 'share-child-frame
7295 (frame-parameters frame1)))
7296 (when (eq share share1)
7297 (setq frame frame1)
7298 (throw 'frame t))))))
7299
7300 (if frame
7301 (setq window (frame-selected-window frame))
7302 (setq frame (make-frame parameters))
7303 (setq window (frame-selected-window frame))))
7304
7305 (prog1 (window--display-buffer
7306 buffer window 'frame alist display-buffer-mark-dedicated)
7307 (unless (cdr (assq 'inhibit-switch-frame alist))
7308 (window--maybe-raise-frame frame)))))
7309
7261(defun display-buffer-below-selected (buffer alist) 7310(defun display-buffer-below-selected (buffer alist)
7262 "Try displaying BUFFER in a window below the selected window. 7311 "Try displaying BUFFER in a window below the selected window.
7263If there is a window below the selected one and that window 7312If there is a window below the selected one and that window
@@ -7272,7 +7321,8 @@ below the selected one, use that window."
7272 (and (not (frame-parameter nil 'unsplittable)) 7321 (and (not (frame-parameter nil 'unsplittable))
7273 (let ((split-height-threshold 0) 7322 (let ((split-height-threshold 0)
7274 split-width-threshold) 7323 split-width-threshold)
7275 (setq window (window--try-to-split-window (selected-window) alist))) 7324 (setq window (window--try-to-split-window
7325 (selected-window) alist)))
7276 (window--display-buffer 7326 (window--display-buffer
7277 buffer window 'window alist display-buffer-mark-dedicated)) 7327 buffer window 'window alist display-buffer-mark-dedicated))
7278 (and (setq window (window-in-direction 'below)) 7328 (and (setq window (window-in-direction 'below))
@@ -7885,10 +7935,12 @@ See also `fit-frame-to-buffer-margins'."
7885(declare-function x-display-pixel-height "xfns.c" (&optional terminal)) 7935(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
7886 7936
7887(defun window--sanitize-margin (margin left right) 7937(defun window--sanitize-margin (margin left right)
7888 "Return MARGIN if it's a number between LEFT and RIGHT." 7938 "Return MARGIN if it's a number between LEFT and RIGHT.
7889 (when (and (numberp margin) 7939Return 0 otherwise."
7890 (<= left (- right margin)) (<= margin right)) 7940 (if (and (numberp margin)
7891 margin)) 7941 (<= left (- right margin)) (<= margin right))
7942 margin
7943 0))
7892 7944
7893(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) 7945(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
7894 7946
@@ -7906,190 +7958,197 @@ horizontally only.
7906 7958
7907The new position and size of FRAME can be additionally determined 7959The new position and size of FRAME can be additionally determined
7908by customizing the options `fit-frame-to-buffer-sizes' and 7960by customizing the options `fit-frame-to-buffer-sizes' and
7909`fit-frame-to-buffer-margins' or the corresponding parameters of 7961`fit-frame-to-buffer-margins' or setting the corresponding
7910FRAME." 7962parameters of FRAME."
7911 (interactive) 7963 (interactive)
7912 (unless (and (fboundp 'x-display-pixel-height) 7964 (unless (fboundp 'display-monitor-attributes-list)
7913 ;; We need the respective sizes now.
7914 (fboundp 'display-monitor-attributes-list))
7915 (user-error "Cannot resize frame in non-graphic Emacs")) 7965 (user-error "Cannot resize frame in non-graphic Emacs"))
7916 (setq frame (window-normalize-frame frame)) 7966 (setq frame (window-normalize-frame frame))
7917 (when (window-live-p (frame-root-window frame)) 7967 (when (window-live-p (frame-root-window frame))
7918 (with-selected-window (frame-root-window frame) 7968 (let* ((char-width (frame-char-width frame))
7919 (let* ((char-width (frame-char-width)) 7969 (char-height (frame-char-height frame))
7920 (char-height (frame-char-height)) 7970 ;; WINDOW is FRAME's root window.
7921 (monitor-attributes (car (display-monitor-attributes-list 7971 (window (frame-root-window frame))
7922 (frame-parameter frame 'display)))) 7972 (parent (frame-parent frame))
7923 (geometry (cdr (assq 'geometry monitor-attributes))) 7973 (monitor-attributes
7924 (display-width (- (nth 2 geometry) (nth 0 geometry))) 7974 (unless parent
7925 (display-height (- (nth 3 geometry) (nth 1 geometry))) 7975 (car (display-monitor-attributes-list
7926 (workarea (cdr (assq 'workarea monitor-attributes))) 7976 (frame-parameter frame 'display)))))
7927 ;; Handle margins. 7977 ;; FRAME'S parent or display sizes. Used in connection
7928 (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins) 7978 ;; with margins.
7929 fit-frame-to-buffer-margins)) 7979 (geometry
7930 (left-margin (if (nth 0 margins) 7980 (unless parent
7931 (or (window--sanitize-margin 7981 (cdr (assq 'geometry monitor-attributes))))
7932 (nth 0 margins) 0 display-width) 7982 (parent-or-display-width
7933 0) 7983 (if parent
7934 (nth 0 workarea))) 7984 (frame-native-width parent)
7935 (top-margin (if (nth 1 margins) 7985 (- (nth 2 geometry) (nth 0 geometry))))
7936 (or (window--sanitize-margin 7986 (parent-or-display-height
7937 (nth 1 margins) 0 display-height) 7987 (if parent
7938 0) 7988 (frame-native-height parent)
7939 (nth 1 workarea))) 7989 (- (nth 3 geometry) (nth 1 geometry))))
7940 (workarea-width (nth 2 workarea)) 7990 ;; FRAME'S parent or workarea sizes. Used when no margins
7941 (right-margin (if (nth 2 margins) 7991 ;; are specified.
7942 (- display-width 7992 (parent-or-workarea
7943 (or (window--sanitize-margin 7993 (if parent
7944 (nth 2 margins) left-margin display-width) 7994 `(0 0 ,parent-or-display-width ,parent-or-display-height)
7945 0)) 7995 (cdr (assq 'workarea monitor-attributes))))
7946 (nth 2 workarea))) 7996 ;; The outer size of FRAME. Needed to calculate the
7947 (workarea-height (nth 3 workarea)) 7997 ;; margins around the root window's body that have to
7948 (bottom-margin (if (nth 3 margins) 7998 ;; remain untouched by fitting.
7949 (- display-height 7999 (outer-edges (frame-edges frame 'outer-edges))
7950 (or (window--sanitize-margin 8000 (outer-width (if outer-edges
7951 (nth 3 margins) top-margin display-height) 8001 (- (nth 2 outer-edges) (nth 0 outer-edges))
7952 0)) 8002 ;; A poor guess.
7953 (nth 3 workarea))) 8003 (frame-pixel-width frame)))
7954 ;; The pixel width of FRAME (which does not include the 8004 (outer-height (if outer-edges
7955 ;; window manager's decorations). 8005 (- (nth 3 outer-edges) (nth 1 outer-edges))
7956 (frame-width (frame-pixel-width)) 8006 ;; Another poor guess.
7957 ;; The pixel width of the body of FRAME's root window. 8007 (frame-pixel-height frame)))
7958 (window-body-width (window-body-width nil t)) 8008 ;; The text size of of FRAME. Needed to specify FRAME's
7959 ;; The difference in pixels between total and body width of 8009 ;; text size after the root window's body's new sizes have
7960 ;; FRAME's window. 8010 ;; been calculated.
7961 (window-extra-width (- (window-pixel-width) window-body-width)) 8011 (text-width (frame-text-width frame))
7962 ;; The difference in pixels between the frame's pixel width 8012 (text-height (frame-text-height frame))
7963 ;; and the window's body width. This is the space we can't 8013 ;; WINDOW's body size.
7964 ;; use for fitting. 8014 (body-width (window-body-width window t))
7965 (extra-width (- frame-width window-body-width)) 8015 (body-height (window-body-height window t))
7966 ;; The pixel position of FRAME's left border. We usually 8016 ;; The difference between FRAME's outer size and WINDOW's
7967 ;; try to leave this alone. 8017 ;; body size.
7968 (left 8018 (outer-minus-body-width (- outer-width body-width))
7969 (let ((left (frame-parameter nil 'left))) 8019 (outer-minus-body-height (- outer-height body-height))
7970 (if (consp left) 8020 ;; The difference between FRAME's text size and WINDOW's
7971 (funcall (car left) (cadr left)) 8021 ;; body size (these values "should" be positive).
7972 left))) 8022 (text-minus-body-width (- text-width body-width))
7973 ;; The pixel height of FRAME (which does not include title 8023 (text-minus-body-height (- text-height body-height))
7974 ;; line, decorations, and sometimes neither the menu nor 8024 ;; The current position of FRAME.
7975 ;; the toolbar). 8025 (position (frame-position frame))
7976 (frame-height (frame-pixel-height)) 8026 (left (car position))
7977 ;; The pixel height of FRAME's root window (we don't care 8027 (top (cdr position))
7978 ;; about the window's body height since the return value of 8028 ;; The margins specified for FRAME. These represent pixel
7979 ;; `window-text-pixel-size' includes header and mode line). 8029 ;; offsets from the left, top, right and bottom edge of the
7980 (window-height (window-pixel-height)) 8030 ;; display or FRAME's parent's native rectangle and have to
7981 ;; The difference in pixels between the frame's pixel 8031 ;; take care of the display's taskbar and other obstacles.
7982 ;; height and the window's height. 8032 ;; If they are unspecified, constrain the resulting frame
7983 (extra-height (- frame-height window-height)) 8033 ;; to its workarea or the parent frame's native rectangle.
7984 ;; The pixel position of FRAME's top border. 8034 (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
7985 (top 8035 fit-frame-to-buffer-margins))
7986 (let ((top (frame-parameter nil 'top))) 8036 ;; Convert margins intto pixel offsets from the left-top
7987 (if (consp top) 8037 ;; corner of FRAME's display or parent.
7988 (funcall (car top) (cadr top)) 8038 (left-margin (if (nth 0 margins)
7989 top))) 8039 (window--sanitize-margin
7990 ;; Sanitize minimum and maximum sizes. 8040 (nth 0 margins) 0 parent-or-display-width)
7991 (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes) 8041 (nth 0 parent-or-workarea)))
7992 fit-frame-to-buffer-sizes)) 8042 (top-margin (if (nth 1 margins)
7993 (max-height 8043 (window--sanitize-margin
7994 (cond 8044 (nth 1 margins) 0 parent-or-display-height)
7995 ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height)) 8045 (nth 1 parent-or-workarea)))
7996 ((numberp max-height) (* max-height char-height)) 8046 (right-margin (if (nth 2 margins)
7997 (t display-height))) 8047 (- parent-or-display-width
7998 (min-height 8048 (window--sanitize-margin
7999 (cond 8049 (nth 2 margins) left-margin
8000 ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height)) 8050 parent-or-display-width))
8001 ((numberp min-height) (* min-height char-height)) 8051 (nth 2 parent-or-workarea)))
8002 (t (* window-min-height char-height)))) 8052 (bottom-margin (if (nth 3 margins)
8003 (max-width 8053 (- parent-or-display-height
8004 (cond 8054 (window--sanitize-margin
8005 ((numberp (nth 2 sizes)) 8055 (nth 3 margins) top-margin
8006 (- (* (nth 2 sizes) char-width) window-extra-width)) 8056 parent-or-display-height))
8007 ((numberp max-width) 8057 (nth 3 parent-or-workarea)))
8008 (- (* max-width char-width) window-extra-width)) 8058 ;; Minimum and maximum sizes specified for FRAME.
8009 (t display-width))) 8059 (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
8010 (min-width 8060 fit-frame-to-buffer-sizes))
8011 (cond 8061 ;; Calculate the minimum and maximum pixel sizes of FRAME
8012 ((numberp (nth 3 sizes)) 8062 ;; from the values provided by the MAX-HEIGHT, MIN-HEIGHT,
8013 (- (* (nth 3 sizes) char-width) window-extra-width)) 8063 ;; MAX-WIDTH and MIN-WIDTH arguments or, if these are nil,
8014 ((numberp min-width) 8064 ;; from those provided by `fit-frame-to-buffer-sizes'.
8015 (- (* min-width char-width) window-extra-width)) 8065 (max-height
8016 (t (* window-min-width char-width)))) 8066 (min
8017 ;; Note: Currently, for a new frame the sizes of the header 8067 (cond
8018 ;; and mode line may be estimated incorrectly 8068 ((numberp max-height) (* max-height char-height))
8019 (value (window-text-pixel-size 8069 ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
8020 nil t t workarea-width workarea-height t)) 8070 (t parent-or-display-height))
8021 (width (+ (car value) (window-right-divider-width))) 8071 ;; The following is the maximum height that fits into the
8022 (height 8072 ;; top and bottom margins.
8023 (+ (cdr value) 8073 (max (- bottom-margin top-margin outer-minus-body-height))))
8024 (window-bottom-divider-width) 8074 (min-height
8025 (window-scroll-bar-height)))) 8075 (cond
8026 ;; Don't change height or width when the window's size is fixed 8076 ((numberp min-height) (* min-height char-height))
8027 ;; in either direction or ONLY forbids it. 8077 ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
8028 (cond 8078 (t (window-min-size window nil nil t))))
8029 ((or (eq window-size-fixed 'width) (eq only 'vertically)) 8079 (max-width
8030 (setq width nil)) 8080 (min
8031 ((or (eq window-size-fixed 'height) (eq only 'horizontally)) 8081 (cond
8032 (setq height nil))) 8082 ((numberp max-width) (* max-width char-width))
8033 ;; Fit width to constraints. 8083 ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
8034 (when width 8084 (t parent-or-display-width))
8035 (unless frame-resize-pixelwise 8085 ;; The following is the maximum width that fits into the
8036 ;; Round to character sizes. 8086 ;; left and right margins.
8037 (setq width (* (/ (+ width char-width -1) char-width) 8087 (max (- right-margin left-margin outer-minus-body-width))))
8038 char-width))) 8088 (min-width
8039 ;; Fit to maximum and minimum widths. 8089 (cond
8040 (setq width (max (min width max-width) min-width)) 8090 ((numberp min-width) (* min-width char-width))
8041 ;; Add extra width. 8091 ((numberp (nth 3 sizes)) (nth 3 sizes))
8042 (setq width (+ width extra-width)) 8092 (t (window-min-size window t nil t))))
8043 ;; Preserve margins. 8093 ;; Note: Currently, for a new frame the sizes of the header
8044 (let ((right (+ left width))) 8094 ;; and mode line may be estimated incorrectly
8045 (cond 8095 (size
8046 ((> right right-margin) 8096 (window-text-pixel-size window t t max-width max-height))
8047 ;; Move frame to left (we don't know its real width). 8097 (width (max (car size) min-width))
8048 (setq left (max left-margin (- left (- right right-margin))))) 8098 (height (max (cdr size) min-height)))
8049 ((< left left-margin) 8099 ;; Don't change height or width when the window's size is fixed
8050 ;; Move frame to right. 8100 ;; in either direction or ONLY forbids it.
8051 (setq left left-margin))))) 8101 (cond
8052 ;; Fit height to constraints. 8102 ((or (eq window-size-fixed 'width) (eq only 'vertically))
8053 (when height 8103 (setq width nil))
8054 (unless frame-resize-pixelwise 8104 ((or (eq window-size-fixed 'height) (eq only 'horizontally))
8055 (setq height (* (/ (+ height char-height -1) char-height) 8105 (setq height nil)))
8056 char-height))) 8106 ;; Fit width to constraints.
8057 ;; Fit to maximum and minimum heights. 8107 (when width
8058 (setq height (max (min height max-height) min-height)) 8108 (unless frame-resize-pixelwise
8059 ;; Add extra height. 8109 ;; Round to character sizes.
8060 (setq height (+ height extra-height)) 8110 (setq width (* (/ (+ width char-width -1) char-width)
8061 ;; Preserve margins. 8111 char-width)))
8062 (let ((bottom (+ top height))) 8112 ;; The new outer width (in pixels).
8063 (cond 8113 (setq outer-width (+ width outer-minus-body-width))
8064 ((> bottom bottom-margin) 8114 ;; Maybe move FRAME to preserve margins.
8065 ;; Move frame up (we don't know its real height). 8115 (let ((right (+ left outer-width)))
8066 (setq top (max top-margin (- top (- bottom bottom-margin))))) 8116 (cond
8067 ((< top top-margin) 8117 ((> right right-margin)
8068 ;; Move frame down. 8118 ;; Move frame to left.
8069 (setq top top-margin))))) 8119 (setq left (max left-margin (- left (- right right-margin)))))
8070 ;; Apply changes. 8120 ((< left left-margin)
8071 (set-frame-position frame left top) 8121 ;; Move frame to right.
8072 ;; Clumsily try to translate our calculations to what 8122 (setq left left-margin)))))
8073 ;; `set-frame-size' wants. 8123 ;; Fit height to constraints.
8074 (when width 8124 (when height
8075 (setq width (- (+ (frame-text-width) width) 8125 (unless frame-resize-pixelwise
8076 extra-width window-body-width))) 8126 (setq height (* (/ (+ height char-height -1) char-height)
8077 (when height 8127 char-height)))
8078 (setq height (- (+ (frame-text-height) height) 8128 ;; The new outer height.
8079 extra-height window-height))) 8129 (setq outer-height (+ height outer-minus-body-height))
8080 (set-frame-size 8130 ;; Preserve margins.
8081 frame 8131 (let ((bottom (+ top outer-height)))
8082 (if width 8132 (cond
8083 (if frame-resize-pixelwise 8133 ((> bottom bottom-margin)
8084 width 8134 ;; Move frame up.
8085 (/ width char-width)) 8135 (setq top (max top-margin (- top (- bottom bottom-margin)))))
8086 (frame-text-width)) 8136 ((< top top-margin)
8087 (if height 8137 ;; Move frame down.
8088 (if frame-resize-pixelwise 8138 (setq top top-margin)))))
8089 height 8139 ;; Apply our changes.
8090 (/ height char-height)) 8140 (setq text-width
8091 (frame-text-height)) 8141 (if width
8092 frame-resize-pixelwise))))) 8142 (+ width text-minus-body-width)
8143 (frame-text-width frame)))
8144 (setq text-height
8145 (if height
8146 (+ height text-minus-body-height)
8147 (frame-text-height frame)))
8148 (modify-frame-parameters
8149 frame `((left . ,left) (top . ,top)
8150 (width . (text-pixels . ,text-width))
8151 (height . (text-pixels . ,text-height)))))))
8093 8152
8094(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size) 8153(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size)
8095 "Adjust size of WINDOW to display its buffer's contents exactly. 8154 "Adjust size of WINDOW to display its buffer's contents exactly.
@@ -8286,6 +8345,168 @@ Return non-nil if the window was shrunk, nil otherwise."
8286 (when (and (window-combined-p window) 8345 (when (and (window-combined-p window)
8287 (pos-visible-in-window-p (point-min) window)) 8346 (pos-visible-in-window-p (point-min) window))
8288 (fit-window-to-buffer window (window-total-height window)))) 8347 (fit-window-to-buffer window (window-total-height window))))
8348
8349(defun window-largest-empty-rectangle--maximums-1 (quad maximums)
8350 "Support function for `window-largest-empty-rectangle'."
8351 (cond
8352 ((null maximums)
8353 (list quad))
8354 ((> (car quad) (caar maximums))
8355 (cons quad maximums))
8356 (t
8357 (cons (car maximums)
8358 (window-largest-empty-rectangle--maximums-1 quad (cdr maximums))))))
8359
8360(defun window-largest-empty-rectangle--maximums (quad maximums count)
8361 "Support function for `window-largest-empty-rectangle'."
8362 (setq maximums (window-largest-empty-rectangle--maximums-1 quad maximums))
8363 (if (> (length maximums) count)
8364 (nbutlast maximums)
8365 maximums))
8366
8367(defun window-largest-empty-rectangle--disjoint-maximums (maximums count)
8368 "Support function for `window-largest-empty-rectangle'."
8369 (setq maximums (sort maximums (lambda (x y) (> (car x) (car y)))))
8370 (let ((new-length 0)
8371 new-maximums)
8372 (while (and maximums (< new-length count))
8373 (let* ((maximum (car maximums))
8374 (at (nth 2 maximum))
8375 (to (nth 3 maximum)))
8376 (catch 'drop
8377 (dolist (new-maximum new-maximums)
8378 (let ((new-at (nth 2 new-maximum))
8379 (new-to (nth 3 new-maximum)))
8380 (when (if (< at new-at) (> to new-at) (< at new-to))
8381 ;; Intersection -> drop.
8382 (throw 'drop nil))))
8383 (setq new-maximums (cons maximum new-maximums))
8384 (setq new-length (1+ new-length)))
8385 (setq maximums (cdr maximums))))
8386
8387 (nreverse new-maximums)))
8388
8389(defun window-largest-empty-rectangle (&optional window count min-width min-height positions left)
8390 "Return dimensions of largest empty rectangle in WINDOW.
8391WINDOW must be a live window and defaults to the selected one.
8392
8393The return value is a triple of the width and the start and end
8394Y-coordinates of the largest rectangle that can be inscribed into
8395the empty space (the space not displaying any text) of WINDOW's
8396text area. The return value is nil if the current glyph matrix
8397of WINDOW is not up-to-date.
8398
8399Optional argument COUNT, if non-nil, specifies the maximum number
8400of rectangles to return. This means that the return value is a
8401list of triples specifying rectangles with the largest rectangle
8402first. COUNT can be also a cons cell whose car specifies the
8403number of rectangles to return and whose cdr, if non-nil, states
8404that all rectangles returned must be disjoint.
8405
8406Note that the right edge of any rectangle returned by this
8407function is the right edge of WINDOW (the left edge if its buffer
8408displays RTL text).
8409
8410Optional arguments MIN-WIDTH and MIN-HEIGHT, if non-nil, specify
8411the minimum width and height of any rectangle returned.
8412
8413Optional argument POSITIONS, if non-nil, is a cons cell whose car
8414specifies the uppermost and whose cdr specifies the lowermost
8415pixel position that must be covered by any rectangle returned.
8416Note that positions are counted from the start of the text area
8417of WINDOW.
8418
8419Optional argument LEFT, if non-nil, means to return values suitable for
8420buffers displaying right to left text."
8421 ;; Process lines as returned by ‘window-lines-pixel-dimensions’.
8422 ;; STACK is a stack that contains rows that have to be processed yet.
8423 (let* ((window (window-normalize-window window t))
8424 (disjoint (and (consp count) (cdr count)))
8425 (count (or (and (numberp count) count)
8426 (and (consp count) (numberp (car count)) (car count))))
8427 (rows (window-lines-pixel-dimensions window nil nil t t left))
8428 (rows-at 0)
8429 (max-size 0)
8430 row stack stack-at stack-to
8431 top top-width top-at top-to top-size
8432 max-width max-at max-to maximums)
8433 ;; ROWS-AT is the position where the first element of ROWS starts.
8434 ;; STACK-AT is the position where the first element of STACK starts.
8435 (while rows
8436 (setq row (car rows))
8437 (if (or (not stack) (>= (car row) (caar stack)))
8438 (progn
8439 (unless stack
8440 (setq stack-at rows-at))
8441 (setq stack (cons row stack))
8442 ;; Set ROWS-AT to where the first element of ROWS ends
8443 ;; which, after popping ROW, makes it the start position of
8444 ;; the next ROW.
8445 (setq rows-at (cdr row))
8446 (setq rows (cdr rows)))
8447 (setq top (car stack))
8448 (setq stack (cdr stack))
8449 (setq top-width (car top))
8450 (setq top-at (if stack (cdar stack) stack-at))
8451 (setq top-to (cdr top))
8452 (setq top-size (* top-width (- top-to top-at)))
8453 (unless (or (and min-width (< top-width min-width))
8454 (and min-height (< (- top-to top-at) min-height))
8455 (and positions
8456 (or (> top-at (car positions))
8457 (< top-to (cdr positions)))))
8458 (if count
8459 (if disjoint
8460 (setq maximums (cons (list top-size top-width top-at top-to)
8461 maximums))
8462 (setq maximums (window-largest-empty-rectangle--maximums
8463 (list top-size top-width top-at top-to)
8464 maximums count)))
8465 (when (> top-size max-size)
8466 (setq max-size top-size)
8467 (setq max-width top-width)
8468 (setq max-at top-at)
8469 (setq max-to top-to))))
8470 (if (and stack (> (caar stack) (car row)))
8471 ;; Have new top element of stack include old top.
8472 (setq stack (cons (cons (caar stack) (cdr top)) (cdr stack)))
8473 ;; Move rows-at backwards to top-at.
8474 (setq rows-at top-at))))
8475
8476 (when stack
8477 ;; STACK-TO is the position where the stack ends.
8478 (setq stack-to (cdar stack))
8479 (while stack
8480 (setq top (car stack))
8481 (setq stack (cdr stack))
8482 (setq top-width (car top))
8483 (setq top-at (if stack (cdar stack) stack-at))
8484 (setq top-size (* top-width (- stack-to top-at)))
8485 (unless (or (and min-width (< top-width min-width))
8486 (and min-height (< (- stack-to top-at) min-height))
8487 (and positions
8488 (or (> top-at (car positions))
8489 (< stack-to (cdr positions)))))
8490 (if count
8491 (if disjoint
8492 (setq maximums (cons (list top-size top-width top-at stack-to)
8493 maximums))
8494 (setq maximums (window-largest-empty-rectangle--maximums
8495 (list top-size top-width top-at stack-to)
8496 maximums count)))
8497 (when (> top-size max-size)
8498 (setq max-size top-size)
8499 (setq max-width top-width)
8500 (setq max-at top-at)
8501 (setq max-to stack-to))))))
8502
8503 (cond
8504 (maximums
8505 (if disjoint
8506 (window-largest-empty-rectangle--disjoint-maximums maximums count)
8507 maximums))
8508 ((> max-size 0)
8509 (list max-width max-at max-to)))))
8289 8510
8290(defun kill-buffer-and-window () 8511(defun kill-buffer-and-window ()
8291 "Kill the current buffer and delete the selected window." 8512 "Kill the current buffer and delete the selected window."