;;; window.el --- GNU Emacs window commands aside from those written in C
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2011
+;; Copyright (C) 1985, 1989, 1992-1994, 2000-2012
;; Free Software Foundation, Inc.
;; Maintainer: FSF
for PARAMETER equals VALUE (comparison is done with `equal').
Optional argument ANY non-nil means consider internal windows
too."
- (let (this-value windows)
+ (let (this-value)
(catch 'found
(walk-window-tree
(lambda (window)
to display at most that many side windows on the corresponding
side. If an element is nil, this means there's no bound on the
number of slots on that side."
+ :version "24.1"
:risky t
:type
'(list
parent whose window-side parameter is nil and there must be no
leaf window whose window-side parameter is nil."
(let (normal none left top right bottom
- side parent parent-side code)
+ side parent parent-side)
(when (or (catch 'reset
(walk-window-tree
(lambda (window)
(if (window-combined-p sub horizontal)
;; In an iso-combination try to extract DELTA from WINDOW's
;; siblings.
- (let ((first sub)
- (skip (eq trail 'after))
+ (let ((skip (eq trail 'after))
this-delta other-delta)
;; Decide which windows shall be left alone.
(while sub
(setq window (window-normalize-window window))
(let ((frame (window-frame window))
(right window)
- left this-delta min-delta max-delta failed)
+ left this-delta min-delta max-delta)
;; Find the edge we want to move.
(while (and (or (not (window-combined-p right horizontal))
(not (window-right right)))
(when (window-parameter window 'window-atom)
(setq window (window-atom-root window))))
- (let* ((parent (window-parent window))
- (frame (window-frame window))
- (buffer (window-buffer window)))
+ (let ((parent (window-parent window))
+ (frame (window-frame window)))
(cond
((frame-root-window-p window)
;; WINDOW's frame can be deleted only if there are other frames
(throw 'done (delete-other-windows atom-root)))
((eq window-side 'none)
;; Set side-main to the major non-side window.
- (setq side-main (window-with-parameter 'window-side 'none nil t)))
+ (setq side-main (window-with-parameter 'window-side 'none frame t)))
((memq window-side window-sides)
(error "Cannot make side window the only window")))
;; If WINDOW is the main non-side window, do nothing.
if WINDOW gets deleted or its frame is auto-hidden."
(setq window (window-normalize-window window t))
(unless (and dedicated-only (not (window-dedicated-p window)))
- (let* ((buffer (window-buffer window))
- (deletable (window-deletable-p window)))
+ (let ((deletable (window-deletable-p window)))
(cond
((eq deletable 'frame)
(let ((frame (window-frame window)))
(number-of-children 0)
(parent-size (window-new-total window))
(total-sum parent-size)
- found failed size sub-total sub-delta sub-amount rest)
+ failed size sub-total sub-delta sub-amount rest)
(while sub
(setq number-of-children (1+ number-of-children))
(when (window-size-fixed-p sub horizontal)
(while (and sub (not failed))
;; Ignore child windows that should be ignored or are stuck.
(unless (window--resize-child-windows-skip-p sub)
- (setq found t)
(setq sub-total (window-total-size sub horizontal))
(setq sub-delta (- size sub-total))
(setq sub-amount
))
;;; Window states, how to get them and how to put them in a window.
-(defvar window-state-ignored-parameters '(quit-restore)
- "List of window parameters ignored by `window-state-get'.")
-
-(defun window--state-get-1 (window &optional markers)
+(defun window--state-get-1 (window &optional writable)
"Helper function for `window-state-get'."
(let* ((type
(cond
(normal-height . ,(window-normal-size window))
(normal-width . ,(window-normal-size window t))
(combination-limit . ,(window-combination-limit window))
- ,@(let (list)
- (dolist (parameter (window-parameters window))
- (unless (memq (car parameter)
- window-state-ignored-parameters)
- (setq list (cons parameter list))))
- (unless (window-parameter window 'clone-of)
- ;; Make a clone-of parameter.
- (setq list (cons (cons 'clone-of window) list)))
+ ,@(let ((parameters (window-parameters window))
+ list)
+ ;; Make copies of those window parameters whose
+ ;; persistence property is `writable' if WRITABLE is
+ ;; non-nil and non-nil if WRITABLE is nil.
+ (dolist (par parameters)
+ (let ((pers (cdr (assq (car par)
+ window-persistent-parameters))))
+ (when (and pers (or (not writable) (eq pers 'writable)))
+ (setq list (cons (cons (car par) (cdr par)) list)))))
+ ;; Add `clone-of' parameter if necessary.
+ (let ((pers (cdr (assq 'clone-of
+ window-persistent-parameters))))
+ (when (and pers (or (not writable) (eq pers 'writable))
+ (not (assq 'clone-of list)))
+ (setq list (cons (cons 'clone-of window) list))))
(when list
`((parameters . ,list))))
,@(when buffer
- ;; All buffer related things go in here - make the buffer
- ;; current when retrieving `point' and `mark'.
- (with-current-buffer (window-buffer window)
- (let ((point (window-point-1 window))
- (start (window-start window))
- (mark (mark)))
- `((buffer
- ,(buffer-name buffer)
- (selected . ,selected)
- ,@(when window-size-fixed
- `((size-fixed . ,window-size-fixed)))
- (hscroll . ,(window-hscroll window))
- (fringes . ,(window-fringes window))
- (margins . ,(window-margins window))
- (scroll-bars . ,(window-scroll-bars window))
- (vscroll . ,(window-vscroll window))
- (dedicated . ,(window-dedicated-p window))
- (point . ,(if markers (copy-marker point) point))
- (start . ,(if markers (copy-marker start) start))
- ,@(when mark
- `((mark . ,(if markers
- (copy-marker mark) mark)))))))))))
+ ;; All buffer related things go in here.
+ (let ((point (window-point-1 window))
+ (start (window-start window)))
+ `((buffer
+ ,(buffer-name buffer)
+ (selected . ,selected)
+ (hscroll . ,(window-hscroll window))
+ (fringes . ,(window-fringes window))
+ (margins . ,(window-margins window))
+ (scroll-bars . ,(window-scroll-bars window))
+ (vscroll . ,(window-vscroll window))
+ (dedicated . ,(window-dedicated-p window))
+ (point . ,(if writable point (copy-marker point)))
+ (start . ,(if writable start (copy-marker start)))))))))
(tail
(when (memq type '(vc hc))
(let (list)
(setq window (window-child window))
(while window
- (setq list (cons (window--state-get-1 window markers) list))
+ (setq list (cons (window--state-get-1 window writable) list))
(setq window (window-right window)))
(nreverse list)))))
(append head tail)))
-(defun window-state-get (&optional window markers)
+(defun window-state-get (&optional window writable)
"Return state of WINDOW as a Lisp object.
WINDOW can be any window and defaults to the root window of the
selected frame.
-Optional argument MARKERS non-nil means use markers for sampling
-positions like `window-point' or `window-start'. MARKERS should
-be non-nil only if the value is used for putting the state back
-in the same session (note that markers slow down processing).
+Optional argument WRITABLE non-nil means do not use markers for
+sampling `window-point' and `window-start'. Together, WRITABLE
+and the variable `window-persistent-parameters' specify which
+window parameters are saved by this function. WRITABLE should be
+non-nil when the return value shall be written to a file and read
+back in another session. Otherwise, an application may run into
+an `invalid-read-syntax' error while attempting to read back the
+value from file.
The return value can be used as argument for `window-state-put'
to put the state recorded here into an arbitrary window. The
(min-height-ignore . ,(window-min-size window nil t))
(min-width-ignore . ,(window-min-size window t t))
(min-height-safe . ,(window-min-size window nil 'safe))
- (min-width-safe . ,(window-min-size window t 'safe))
- ;; These are probably not needed.
- ,@(when (window-size-fixed-p window) `((fixed-height . t)))
- ,@(when (window-size-fixed-p window t) `((fixed-width . t))))
- (window--state-get-1 window markers)))
+ (min-width-safe . ,(window-min-size window t 'safe)))
+ (window--state-get-1 window writable)))
(defvar window-state-put-list nil
"Helper variable for `window-state-put'.")
(if (window-sizable-p window (- size) horizontal 'safe)
(let* ((window-combination-limit
(assq 'combination-limit item)))
- ;; We must inherit the combiantion limit, otherwise
+ ;; We must inherit the combination limit, otherwise
;; we might mess up handling of atomic and side
;; window.
(setq new (split-window window size horizontal)))
"Helper function for `window-state-put'."
(dolist (item window-state-put-list)
(let ((window (car item))
- (splits (cdr (assq 'splits item)))
(combination-limit (cdr (assq 'combination-limit item)))
(parameters (cdr (assq 'parameters item)))
(state (cdr (assq 'buffer item))))
(when combination-limit
(set-window-combination-limit window combination-limit))
- ;; Process parameters.
+ ;; Reset window's parameters and assign saved ones (we might want
+ ;; a `remove-window-parameters' function here).
+ (dolist (parameter (window-parameters window))
+ (set-window-parameter window (car parameter) nil))
(when parameters
(dolist (parameter parameters)
(set-window-parameter window (car parameter) (cdr parameter))))
;; have been created and sized).
(ignore-errors
(set-window-start window (cdr (assq 'start state)))
- (set-window-point window (cdr (assq 'point state)))
- ;; I'm not sure whether we should set the mark here, but maybe
- ;; it can be used.
- (let ((mark (cdr (assq 'mark state))))
- (when mark (set-mark mark))))
+ (set-window-point window (cdr (assq 'point state))))
;; Select window if it's the selected one.
(when (cdr (assq 'selected state))
(select-window window)))))))
(= (window-total-size window t)
(cdr (assq 'total-width state)))))
(min-height (cdr (assq 'min-height head)))
- (min-width (cdr (assq 'min-width head)))
- selected)
+ (min-width (cdr (assq 'min-width head))))
(if (and (not totals)
(or (> min-height (window-total-size window))
(> min-width (window-total-size window t)))
;; The elements of `same-window-regexps' can be regexps
;; or cons cells whose cars are regexps.
(when (or (and (stringp regexp)
- (string-match regexp buffer-name))
+ (string-match-p regexp buffer-name))
(and (consp regexp) (stringp (car regexp))
(string-match-p (car regexp) buffer-name)))
(throw 'found t)))))))
The actual non-nil value of this variable will be copied to the
`window-dedicated-p' flag.")
-(defun window-normalize-buffer-to-display (buffer-or-name)
- "Normalize BUFFER-OR-NAME argument for buffer display functions.
-If BUFFER-OR-NAME is nil, return the current buffer. Else, if a
-buffer specified by BUFFER-OR-NAME exists, return that buffer.
-If no such buffer exists, create a buffer with the name
-BUFFER-OR-NAME and return that buffer."
- (if buffer-or-name
- (or (get-buffer buffer-or-name)
- (let ((buffer (get-buffer-create buffer-or-name)))
- (set-buffer-major-mode buffer)
- buffer))
- (current-buffer)))
-
(defconst display-buffer--action-function-custom-type
'(choice :tag "Function"
(const :tag "--" ignore) ; default for insertion
"Retrieve ALIST entry corresponding to BUFFER-NAME."
(catch 'match
(dolist (entry alist)
- (let ((key (car entry))
- (value (cdr entry)))
+ (let ((key (car entry)))
(when (or (and (stringp key)
(string-match-p key buffer-name))
(and (symbolp key) (functionp key)
"A `display-buffer' action for displaying in another frame.")
(put 'display-buffer--other-frame-action 'risky-local-variable t)
-(defun display-buffer (&optional buffer-or-name action frame)
+(defun display-buffer (buffer-or-name &optional action frame)
"Display BUFFER-OR-NAME in some window, without selecting it.
BUFFER-OR-NAME must be a buffer or the name of an existing
buffer. Return the window chosen for displaying BUFFER-OR-NAME,
`display-buffer-reuse-window'."
(interactive (list (read-buffer "Display buffer: " (other-buffer))
(if current-prefix-arg t)))
- (let ((buffer (window-normalize-buffer-to-display buffer-or-name))
+ (let ((buffer (if (bufferp buffer-or-name)
+ buffer-or-name
+ (get-buffer buffer-or-name)))
;; Handle the old form of the first argument.
(inhibit-same-window (and action (not (listp action)))))
(unless (listp action) (setq action nil))
(funcall special-display-function
buffer ',(if (listp pars) pars)))))))))
-(defun display-buffer-pop-up-frame (buffer alist)
+(defun display-buffer-pop-up-frame (buffer _alist)
"Display BUFFER in a new frame.
This works by calling `pop-up-frame-function'. If successful,
return the window used; otherwise return nil."
(set-window-prev-buffers window nil)
window)))
-(defun display-buffer-pop-up-window (buffer alist)
+(defun display-buffer-pop-up-window (buffer _alist)
"Display BUFFER by popping up a new window.
The new window is created on the selected frame, or in
`last-nonminibuffer-frame' if no windows can be created there.
-If sucessful, return the new window; otherwise return nil."
+If successful, return the new window; otherwise return nil."
(let ((frame (or (window--frame-usable-p (selected-frame))
(window--frame-usable-p (last-nonminibuffer-frame))))
window)
(if current-prefix-arg t)))
(setq buffer (window-normalize-buffer-to-switch-to buffer))
(set-buffer buffer)
- (let* ((old-window (selected-window))
- (old-frame (selected-frame))
+ (let* ((old-frame (selected-frame))
(window (display-buffer buffer action))
(frame (window-frame window)))
;; If we chose another frame, make sure it gets input focus.
HCoop / bpt / emacs.git / blobdiff