From fbf5b3ce9d95a61c06ebf09ee58c809469d71387 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sun, 19 Jun 2011 11:59:58 +0200 Subject: [PATCH] Sanitize processing of display specifiers; new option frame-auto-delete. * window.el (display-buffer-other-window-means-other-frame): Call display-buffer-normalize-alist. (display-buffer-normalize-specifiers-1): Rename to display-buffer-normalize-argument. New argument other-frame. Rewrite. (display-buffer-normalize-specifiers-2): Rename to display-buffer-normalize-options. (display-buffer-normalize-alist-1): New function. (display-buffer-normalize-specifiers-3): Rename to display-buffer-normalize-alist. Call display-buffer-normalize-alist-1. (display-buffer-normalize-options-inhibit): New variable. (display-buffer-normalize-specifiers): Rewrite calling display-buffer-normalize-alist, display-buffer-normalize-argument, and display-buffer-normalize-options. Don't call the latter if display-buffer-normalize-options-inhibit is non-nil. (frame-auto-delete): New option. (window-deletable-p): Use frame-auto-delete. --- lisp/ChangeLog | 22 ++++++++ lisp/window.el | 136 +++++++++++++++++++++++++++++++++++-------------- 2 files changed, 120 insertions(+), 38 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e1a23e53649..281c73528b2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2011-06-19 Martin Rudalics + + * window.el (display-buffer-other-window-means-other-frame): + Call display-buffer-normalize-alist. + (display-buffer-normalize-specifiers-1): Rename to + display-buffer-normalize-argument. New argument other-frame. + Rewrite. + (display-buffer-normalize-specifiers-2): Rename to + display-buffer-normalize-options. + (display-buffer-normalize-alist-1): New function. + (display-buffer-normalize-specifiers-3): Rename to + display-buffer-normalize-alist. Call + display-buffer-normalize-alist-1. + (display-buffer-normalize-options-inhibit): New variable. + (display-buffer-normalize-specifiers): Rewrite calling + display-buffer-normalize-alist, + display-buffer-normalize-argument, and + display-buffer-normalize-options. Don't call the latter if + display-buffer-normalize-options-inhibit is non-nil. + (frame-auto-delete): New option. + (window-deletable-p): Use frame-auto-delete. + 2011-06-18 Chong Yidong * emacs-lisp/rx.el (rx-constituents): Add support for numbered diff --git a/lisp/window.el b/lisp/window.el index 211d8573e0c..454aa6e2941 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2244,6 +2244,28 @@ and no others." (next-window base-window (if nomini 'arg) all-frames)))) ;;; Deleting windows. +(defcustom frame-auto-delete 'automatic + "If non-nil, quitting a window can delete it's frame. +If this variable is nil, functions that quit a window never +delete the associated frame. If this variable equals the symbol +`automatic', a frame is deleted only if it the window is +dedicated or was created by `display-buffer'. If this variable +is t, a frame can be always deleted, even if it was created by +`make-frame-command'. Other values should not be used. + +Note that a frame will be effectively deleted if and only if +another frame still exists. + +Functions quitting a window and consequently affected by this +variable are `switch-to-prev-buffer', `delete-windows-on', +`replace-buffer-in-windows' and `quit-restore-window'." + :type '(choice + (const :tag "Never" nil) + (const :tag "Automatic" automatic) + (const :tag "Always" t)) + :group 'windows + :group 'frames) + (defun window-deletable-p (&optional window) "Return t if WINDOW can be safely deleted from its frame. Return `frame' if deleting WINDOW should delete its frame @@ -2259,9 +2281,12 @@ instead." (quit-restore (window-parameter window 'quit-restore))) (cond ((frame-root-window-p window) - (when (and (or dedicated - (and (eq (car-safe quit-restore) 'new-frame) - (eq (nth 1 quit-restore) (window-buffer window)))) + (when (and (or (eq frame-auto-delete t) + (and (eq frame-auto-delete 'automatic) + (or dedicated + (and (eq (car-safe quit-restore) 'new-frame) + (eq (nth 1 quit-restore) + (window-buffer window)))))) (other-visible-frames-p frame)) ;; WINDOW is the root window of its frame. Return `frame' but ;; only if WINDOW is (1) either dedicated or quit-restore's car @@ -4940,6 +4965,19 @@ SPECIFIERS must be a list of buffer display specifiers." (set-window-parameter window 'window-slot slot)) (display-buffer-in-window buffer window specifiers))))) +(defun normalize-buffer-to-display (buffer-or-name) + "Normalize BUFFER-OR-NAME argument for buffer display functions. +If BUFFER-OR-NAME is nil, return the curent 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))) + (defun display-buffer-other-window-means-other-frame (buffer-or-name &optional label) "Return non-nil if BUFFER shall be preferably displayed in another frame. BUFFER must be a live buffer or the name of a live buffer. @@ -4954,30 +4992,17 @@ Optional argument LABEL is like the same argument of The calculation of the return value is exclusively based on the user preferences expressed in `display-buffer-alist'." (let* ((buffer (normalize-live-buffer buffer-or-name)) - (list (display-buffer-normalize-specifiers-3 - (buffer-name buffer) label)) + (list (display-buffer-normalize-alist (buffer-name buffer) label)) (value (assq 'other-window-means-other-frame (or (car list) (cdr list))))) (when value (cdr value)))) -(defun normalize-buffer-to-display (buffer-or-name) - "Normalize BUFFER-OR-NAME argument for buffer display functions. -If BUFFER-OR-NAME is nil, return the curent 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))) - -(defun display-buffer-normalize-specifiers-1 (specifiers buffer-name label) - "Subroutine of `display-buffer-normalize-specifiers'. -SPECIFIERS is a list of buffer display specfiers. BUFFER-NAME is -the name of the buffer that shall be displayed, LABEL the same -argument of `display-buffer'." +(defun display-buffer-normalize-argument (buffer-name specifiers label other-frame) + "Normalize second argument of `display-buffer'. +BUFFER-NAME is the name of the buffer that shall be displayed, +SPECIFIERS is the second argument of `display-buffer'. LABEL the +same argument of `display-buffer'. OTHER-FRAME non-nil means use +other-frame for other-windo." (let (normalized entry) (cond ((not specifiers) @@ -4990,10 +5015,10 @@ argument of `display-buffer'." (setq normalized (cons specifier normalized))) ((eq specifier 'other-window) ;; `other-window' must be treated separately. - (let* ((other-frame (display-buffer-other-window-means-other-frame - buffer-name label)) - (entry (assq (if other-frame 'other-frame 'other-window) - display-buffer-macro-specifiers))) + (let ((entry (assq (if other-frame + 'other-frame + 'other-window) + display-buffer-macro-specifiers))) (dolist (item (cdr entry)) (setq normalized (cons item normalized))))) ((symbolp specifier) @@ -5008,15 +5033,14 @@ argument of `display-buffer'." ((setq entry (assq specifiers display-buffer-macro-specifiers)) ;; A macro specifier. (cdr entry)) - ((or (display-buffer-other-window-means-other-frame buffer-name label) - (with-no-warnings pop-up-frames)) + ((or other-frame (with-no-warnings pop-up-frames)) ;; Pop up another frame. (cdr (assq 'other-frame display-buffer-macro-specifiers))) (t ;; In any other case pop up a new window. (cdr (assq 'same-frame-other-window display-buffer-macro-specifiers)))))) -(defun display-buffer-normalize-specifiers-2 (&optional buffer-or-name) +(defun display-buffer-normalize-options (buffer-or-name) "Subroutine of `display-buffer-normalize-specifiers'. BUFFER-OR-NAME is the buffer to display. This routine provides a compatibility layer for the now obsolete Emacs 23 buffer display @@ -5127,8 +5151,37 @@ options." specifiers))) -(defun display-buffer-normalize-specifiers-3 (buffer-name label) - "Subroutine of `display-buffer-normalize-specifiers'." +(defun display-buffer-normalize-alist-1 (specifiers label) + "Subroutine of `display-buffer-normalize-alist'. +SPECIFIERS is a list of buffer display specfiers. LABEL is the +same argument of `display-buffer'." + (let (normalized entry) + (cond + ((not specifiers) + nil) + ((listp specifiers) + ;; If SPECIFIERS is a list, we assume it is a list of specifiers. + (dolist (specifier specifiers) + (cond + ((consp specifier) + (setq normalized (cons specifier normalized))) + ((symbolp specifier) + ;; Might be a macro specifier, try to expand it (the cdr is a + ;; list and we have to reverse it later, so do it one at a + ;; time). + (let ((entry (assq specifier display-buffer-macro-specifiers))) + (dolist (item (cdr entry)) + (setq normalized (cons item normalized))))))) + ;; Reverse list. + (nreverse normalized)) + ((setq entry (assq specifiers display-buffer-macro-specifiers)) + ;; A macro specifier. + (cdr entry))))) + +(defun display-buffer-normalize-alist (buffer-name label) + "Normalize `display-buffer-alist'. +BUFFER-NAME must be the name of the buffer that shall be displayed. +LABEL the corresponding argument of `display-buffer'." (let (list-1 list-2) (dolist (entry display-buffer-alist) (when (and (listp entry) @@ -5143,10 +5196,10 @@ options." (string-match-p value buffer-name)) (and (eq type 'label) (eq value label))) (throw 'match t))))))) - (let* ((raw (cdr entry)) + (let* ((specifiers (cdr entry)) (normalized - (display-buffer-normalize-specifiers-1 raw buffer-name label))) - (if (assq 'override raw) + (display-buffer-normalize-alist-1 specifiers label))) + (if (assq 'override specifiers) (setq list-1 (if list-1 (append list-1 normalized) @@ -5158,6 +5211,9 @@ options." (cons list-1 list-2))) +(defvar display-buffer-normalize-options-inhibit nil + "If non-nil, `display-buffer' doesn't process obsolete options.") + (defun display-buffer-normalize-specifiers (buffer-name specifiers label) "Return normalized specifiers for a buffer matching BUFFER-NAME or LABEL. BUFFER-NAME must be a string specifying a valid buffer name. @@ -5179,14 +5235,18 @@ specifiers: component is not set. - `display-buffer-default-specifiers'." - (let* ((list (display-buffer-normalize-specifiers-3 buffer-name label))) + (let* ((list (display-buffer-normalize-alist buffer-name label)) + (other-frame (assq 'other-window-means-other-frame + (or (car list) (cdr list))))) (append ;; Overriding user specifiers. (car list) ;; Application specifiers. - (display-buffer-normalize-specifiers-1 specifiers buffer-name label) + (display-buffer-normalize-argument + buffer-name specifiers label other-frame) ;; Emacs 23 compatibility specifiers. - (display-buffer-normalize-specifiers-2 buffer-name) + (unless display-buffer-normalize-options-inhibit + (display-buffer-normalize-options buffer-name)) ;; Non-overriding user specifiers. (cdr list) ;; Default specifiers. -- 2.39.2