X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9af0f4cde51bc0d68490ae64565a3524b108d063..0578dead3a18ccc5419db3d1d5bb4db43165bd44:/lisp/frame.el diff --git a/lisp/frame.el b/lisp/frame.el index e3fd95a5df..a470fbc0f9 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,6 +1,7 @@ -;;; frame.el --- multi-frame management independent of window systems. +;;; frame.el --- multi-frame management independent of window systems -;; Copyright (C) 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -22,6 +23,8 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + ;;; Code: (defvar frame-creation-function nil @@ -29,9 +32,9 @@ The window system startup file should set this to its frame creation function, which should take an alist of parameters as its argument.") -;;; The initial value given here for used to ask for a minibuffer. -;;; But that's not necessary, because the default is to have one. -;;; By not specifying it here, we let an X resource specify it. +;; The initial value given here used to ask for a minibuffer. +;; But that's not necessary, because the default is to have one. +;; By not specifying it here, we let an X resource specify it. (defcustom initial-frame-alist nil "*Alist of frame parameters for creating the initial X window frame. You can set this in your `.emacs' file; for example, @@ -82,8 +85,9 @@ for pop-up frames." :group 'frames) (setq pop-up-frame-function - (function (lambda () - (make-frame pop-up-frame-alist)))) + ;; Using `function' here caused some sort of problem. + '(lambda () + (make-frame pop-up-frame-alist))) (defcustom special-display-frame-alist '((height . 14) (width . 80) (unsplittable . t)) @@ -110,17 +114,30 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (if (and args (symbolp (car args))) (apply (car args) buffer (cdr args)) (let ((window (get-buffer-window buffer t))) - (if window - ;; If we have a window already, make it visible. - (let ((frame (window-frame window))) - (make-frame-visible frame) - (raise-frame frame) - window) - ;; If no window yet, make one in a new frame. - (let ((frame (make-frame (append args special-display-frame-alist)))) - (set-window-buffer (frame-selected-window frame) buffer) - (set-window-dedicated-p (frame-selected-window frame) t) - (frame-selected-window frame)))))) + (or + ;; If we have a window already, make it visible. + (when window + (let ((frame (window-frame window))) + (make-frame-visible frame) + (raise-frame frame) + window)) + ;; Reuse the current window if the user requested it. + (when (cdr (assq 'same-window args)) + (condition-case nil + (progn (switch-to-buffer buffer) (selected-window)) + (error nil))) + ;; Stay on the same frame if requested. + (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args))) + (let* ((pop-up-frames nil) (pop-up-windows t) + special-display-regexps special-display-buffer-names + (window (display-buffer buffer))) + ;; (set-window-dedicated-p window t) + window)) + ;; If no window yet, make one in a new frame. + (let ((frame (make-frame (append args special-display-frame-alist)))) + (set-window-buffer (frame-selected-window frame) buffer) + (set-window-dedicated-p (frame-selected-window frame) t) + (frame-selected-window frame)))))) (defun handle-delete-frame (event) "Handle delete-frame events from the X server." @@ -140,14 +157,14 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." ;;;; Arrangement of frames at startup -;;; 1) Load the window system startup file from the lisp library and read the -;;; high-priority arguments (-q and the like). The window system startup -;;; file should create any frames specified in the window system defaults. -;;; -;;; 2) If no frames have been opened, we open an initial text frame. -;;; -;;; 3) Once the init file is done, we apply any newly set parameters -;;; in initial-frame-alist to the frame. +;; 1) Load the window system startup file from the lisp library and read the +;; high-priority arguments (-q and the like). The window system startup +;; file should create any frames specified in the window system defaults. +;; +;; 2) If no frames have been opened, we open an initial text frame. +;; +;; 3) Once the init file is done, we apply any newly set parameters +;; in initial-frame-alist to the frame. ;; These are now called explicitly at the proper times, ;; since that is easier to understand. @@ -155,7 +172,7 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." ;; (add-hook 'before-init-hook 'frame-initialize) ;; (add-hook 'window-setup-hook 'frame-notice-user-settings) -;;; If we create the initial frame, this is it. +;; If we create the initial frame, this is it. (defvar frame-initial-frame nil) ;; Record the parameters used in frame-initialize to make the initial frame. @@ -163,11 +180,11 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (defvar frame-initial-geometry-arguments nil) -;;; startup.el calls this function before loading the user's init -;;; file - if there is no frame with a minibuffer open now, create -;;; one to display messages while loading the init file. +;; startup.el calls this function before loading the user's init +;; file - if there is no frame with a minibuffer open now, create +;; one to display messages while loading the init file. (defun frame-initialize () - "Create an in initial frame if necessary." + "Create an initial frame if necessary." ;; Are we actually running under a window system at all? (if (and window-system (not noninteractive) (not (eq window-system 'pc))) (progn @@ -214,20 +231,33 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (defvar frame-notice-user-settings t "Non-nil means function `frame-notice-user-settings' wasn't run yet.") -;;; startup.el calls this function after loading the user's init -;;; file. Now default-frame-alist and initial-frame-alist contain -;;; information to which we must react; do what needs to be done. +;; startup.el calls this function after loading the user's init +;; file. Now default-frame-alist and initial-frame-alist contain +;; information to which we must react; do what needs to be done. (defun frame-notice-user-settings () "Act on user's init file settings of frame parameters. React to settings of `default-frame-alist', `initial-frame-alist' there." ;; Make menu-bar-mode and default-frame-alist consistent. - (if (boundp 'menu-bar-mode) - (let ((default (assq 'menu-bar-lines default-frame-alist))) - (if default - (setq menu-bar-mode (not (eq (cdr default) 0))) - (setq default-frame-alist - (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) - default-frame-alist))))) + (when (boundp 'menu-bar-mode) + (let ((default (assq 'menu-bar-lines default-frame-alist))) + (if default + (setq menu-bar-mode (not (eq (cdr default) 0))) + (setq default-frame-alist + (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) + default-frame-alist))))) + + ;; Make tool-bar-mode and default-frame-alist consistent. Don't do + ;; it in batch mode since that would leave a tool-bar-lines + ;; parameter in default-frame-alist in a dumped Emacs, which is not + ;; what we want. + (when (and (boundp 'tool-bar-mode) + (not noninteractive)) + (let ((default (assq 'tool-bar-lines default-frame-alist))) + (if default + (setq tool-bar-mode (not (eq (cdr default) 0))) + (setq default-frame-alist + (cons (cons 'tool-bar-lines (if tool-bar-mode 1 0)) + default-frame-alist))))) ;; Creating and deleting frames may shift the selected frame around, ;; and thus the current buffer. Protect against that. We don't @@ -238,166 +268,239 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." (when (and frame-notice-user-settings (null frame-initial-frame)) - ;; This case happens when we don't have a window system. + ;; This case happens when we don't have a window system, and + ;; also for MS-DOS frames. (let ((parms (frame-parameters frame-initial-frame))) ;; Don't change the frame names. (setq parms (delq (assq 'name parms) parms)) ;; Can't modify the minibuffer parameter, so don't try. (setq parms (delq (assq 'minibuffer parms) parms)) (modify-frame-parameters nil - (append initial-frame-alist - default-frame-alist - parms - nil)))) + (if (null window-system) + (append initial-frame-alist + default-frame-alist + parms + nil) + ;; initial-frame-alist and + ;; default-frame-alist were already + ;; applied in pc-win.el. + parms)) + (if (null window-system) ;; MS-DOS does this differently in pc-win.el + (let ((newparms (frame-parameters)) + (frame (selected-frame))) + (tty-handle-reverse-video frame newparms) + ;; If we changed the background color, we need to update + ;; the background-mode parameter, and maybe some faces, + ;; too. + (when (assq 'background-color newparms) + (unless (or (assq 'background-mode initial-frame-alist) + (assq 'background-mode default-frame-alist)) + (frame-set-background-mode frame)) + (face-set-after-frame-default frame)))))) ;; If the initial frame is still around, apply initial-frame-alist ;; and default-frame-alist to it. - (if (frame-live-p frame-initial-frame) - - ;; The initial frame we create above always has a minibuffer. - ;; If the user wants to remove it, or make it a minibuffer-only - ;; frame, then we'll have to delete the current frame and make a - ;; new one; you can't remove or add a root window to/from an - ;; existing frame. - ;; - ;; NOTE: default-frame-alist was nil when we created the - ;; existing frame. We need to explicitly include - ;; default-frame-alist in the parameters of the screen we - ;; create here, so that its new value, gleaned from the user's - ;; .emacs file, will be applied to the existing screen. - (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist) - (assq 'minibuffer default-frame-alist) - '(minibuffer . t))) - t)) - ;; Create the new frame. - (let (parms new) - ;; If the frame isn't visible yet, wait till it is. - ;; If the user has to position the window, - ;; Emacs doesn't know its real position until - ;; the frame is seen to be visible. - (while (not (cdr (assq 'visibility - (frame-parameters frame-initial-frame)))) - (sleep-for 1)) - (setq parms (frame-parameters frame-initial-frame)) - ;; Get rid of `name' unless it was specified explicitly before. - (or (assq 'name frame-initial-frame-alist) - (setq parms (delq (assq 'name parms) parms))) - (setq parms (append initial-frame-alist - default-frame-alist - parms - nil)) - ;; Get rid of `reverse', because that was handled - ;; when we first made the frame. - (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms))) - (if (assq 'height frame-initial-geometry-arguments) - (setq parms (assq-delete-all 'height parms))) - (if (assq 'width frame-initial-geometry-arguments) - (setq parms (assq-delete-all 'width parms))) - (if (assq 'left frame-initial-geometry-arguments) - (setq parms (assq-delete-all 'left parms))) - (if (assq 'top frame-initial-geometry-arguments) - (setq parms (assq-delete-all 'top parms))) - (setq new - (make-frame - ;; Use the geometry args that created the existing - ;; frame, rather than the parms we get for it. - (append frame-initial-geometry-arguments - '((user-size . t) (user-position . t)) - parms))) - ;; The initial frame, which we are about to delete, may be - ;; the only frame with a minibuffer. If it is, create a - ;; new one. - (or (delq frame-initial-frame (minibuffer-frame-list)) - (make-initial-minibuffer-frame nil)) - - ;; If the initial frame is serving as a surrogate - ;; minibuffer frame for any frames, we need to wean them - ;; onto a new frame. The default-minibuffer-frame - ;; variable must be handled similarly. - (let ((users-of-initial - (filtered-frame-list - (function (lambda (frame) - (and (not (eq frame frame-initial-frame)) - (eq (window-frame - (minibuffer-window frame)) - frame-initial-frame))))))) - (if (or users-of-initial - (eq default-minibuffer-frame frame-initial-frame)) - - ;; Choose an appropriate frame. Prefer frames which - ;; are only minibuffers. - (let* ((new-surrogate - (car - (or (filtered-frame-list - (function - (lambda (frame) - (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only)))) - (minibuffer-frame-list)))) - (new-minibuffer (minibuffer-window new-surrogate))) - - (if (eq default-minibuffer-frame frame-initial-frame) - (setq default-minibuffer-frame new-surrogate)) - - ;; Wean the frames using frame-initial-frame as - ;; their minibuffer frame. - (mapcar - (function - (lambda (frame) - (modify-frame-parameters - frame (list (cons 'minibuffer new-minibuffer))))) - users-of-initial)))) - - ;; Redirect events enqueued at this frame to the new frame. - ;; Is this a good idea? - (redirect-frame-focus frame-initial-frame new) - - ;; Finally, get rid of the old frame. - (delete-frame frame-initial-frame t)) - - ;; Otherwise, we don't need all that rigamarole; just apply - ;; the new parameters. - (let (newparms allparms tail) - (setq allparms (append initial-frame-alist - default-frame-alist)) + (when (frame-live-p frame-initial-frame) + + ;; When tool-bar has been switched off, correct the frame size + ;; by the lines added in x-create-frame for the tool-bar and + ;; switch `tool-bar-mode' off. + (when (display-graphic-p) + (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) + (assq 'tool-bar-lines default-frame-alist)))) + (when (and tool-bar-originally-present + (or (null tool-bar-lines) + (null (cdr tool-bar-lines)) + (eq 0 (cdr tool-bar-lines)))) + (let* ((char-height (frame-char-height frame-initial-frame)) + (image-height tool-bar-images-pixel-height) + (margin (cond ((and (consp tool-bar-button-margin) + (integerp (cdr tool-bar-button-margin)) + (> tool-bar-button-margin 0)) + (cdr tool-bar-button-margin)) + ((and (integerp tool-bar-button-margin) + (> tool-bar-button-margin 0)) + tool-bar-button-margin) + (t 0))) + (relief (if (and (integerp tool-bar-button-relief) + (> tool-bar-button-relief 0)) + tool-bar-button-relief 3)) + (lines (/ (+ image-height + (* 2 margin) + (* 2 relief) + (1- char-height)) + char-height)) + (height (frame-parameter frame-initial-frame 'height)) + (newparms (list (cons 'height (- height lines)))) + (initial-top (cdr (assq 'top + frame-initial-geometry-arguments))) + (top (frame-parameter frame-initial-frame 'top))) + (when (and (consp initial-top) (eq '- (car initial-top))) + (let ((adjusted-top + (cond ((and (consp top) + (eq '+ (car top))) + (list '+ + (+ (cadr top) + (* lines char-height)))) + ((and (consp top) + (eq '- (car top))) + (list '- + (- (cadr top) + (* lines char-height)))) + (t (+ top (* lines char-height)))))) + (setq newparms + (append newparms + `((top . ,adjusted-top)) + nil)))) + (modify-frame-parameters frame-initial-frame newparms) + (tool-bar-mode -1))))) + + ;; The initial frame we create above always has a minibuffer. + ;; If the user wants to remove it, or make it a minibuffer-only + ;; frame, then we'll have to delete the current frame and make a + ;; new one; you can't remove or add a root window to/from an + ;; existing frame. + ;; + ;; NOTE: default-frame-alist was nil when we created the + ;; existing frame. We need to explicitly include + ;; default-frame-alist in the parameters of the screen we + ;; create here, so that its new value, gleaned from the user's + ;; .emacs file, will be applied to the existing screen. + (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist) + (assq 'minibuffer default-frame-alist) + '(minibuffer . t))) + t)) + ;; Create the new frame. + (let (parms new) + ;; If the frame isn't visible yet, wait till it is. + ;; If the user has to position the window, + ;; Emacs doesn't know its real position until + ;; the frame is seen to be visible. + (while (not (cdr (assq 'visibility + (frame-parameters frame-initial-frame)))) + (sleep-for 1)) + (setq parms (frame-parameters frame-initial-frame)) + + ;; Get rid of `name' unless it was specified explicitly before. + (or (assq 'name frame-initial-frame-alist) + (setq parms (delq (assq 'name parms) parms))) + + (setq parms (append initial-frame-alist + default-frame-alist + parms + nil)) + + ;; Get rid of `reverse', because that was handled + ;; when we first made the frame. + (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms))) + (if (assq 'height frame-initial-geometry-arguments) - (setq allparms (assq-delete-all 'height allparms))) + (setq parms (assq-delete-all 'height parms))) (if (assq 'width frame-initial-geometry-arguments) - (setq allparms (assq-delete-all 'width allparms))) + (setq parms (assq-delete-all 'width parms))) (if (assq 'left frame-initial-geometry-arguments) - (setq allparms (assq-delete-all 'left allparms))) + (setq parms (assq-delete-all 'left parms))) (if (assq 'top frame-initial-geometry-arguments) - (setq allparms (assq-delete-all 'top allparms))) - (setq tail allparms) - ;; Find just the parms that have changed since we first - ;; made this frame. Those are the ones actually set by - ;; the init file. For those parms whose values we already knew - ;; (such as those spec'd by command line options) - ;; it is undesirable to specify the parm again - ;; once the user has seen the frame and been able to alter it - ;; manually. - (while tail - (let (newval oldval) - (setq oldval (assq (car (car tail)) - frame-initial-frame-alist)) - (setq newval (cdr (assq (car (car tail)) allparms))) - (or (and oldval (eq (cdr oldval) newval)) - (setq newparms - (cons (cons (car (car tail)) newval) newparms)))) - (setq tail (cdr tail))) - (setq newparms (nreverse newparms)) - (modify-frame-parameters frame-initial-frame - newparms) - ;; If we changed the background color, - ;; we need to update the background-mode parameter - ;; and maybe some faces too. - (when (assq 'background-color newparms) - (unless (assq 'background-mode newparms) - (frame-set-background-mode frame-initial-frame)) - (face-set-after-frame-default frame-initial-frame)) - (if (assq 'font newparms) - (frame-update-faces frame-initial-frame))))) + (setq parms (assq-delete-all 'top parms))) + (setq new + (make-frame + ;; Use the geometry args that created the existing + ;; frame, rather than the parms we get for it. + (append frame-initial-geometry-arguments + '((user-size . t) (user-position . t)) + parms))) + ;; The initial frame, which we are about to delete, may be + ;; the only frame with a minibuffer. If it is, create a + ;; new one. + (or (delq frame-initial-frame (minibuffer-frame-list)) + (make-initial-minibuffer-frame nil)) + + ;; If the initial frame is serving as a surrogate + ;; minibuffer frame for any frames, we need to wean them + ;; onto a new frame. The default-minibuffer-frame + ;; variable must be handled similarly. + (let ((users-of-initial + (filtered-frame-list + (function (lambda (frame) + (and (not (eq frame frame-initial-frame)) + (eq (window-frame + (minibuffer-window frame)) + frame-initial-frame))))))) + (if (or users-of-initial + (eq default-minibuffer-frame frame-initial-frame)) + + ;; Choose an appropriate frame. Prefer frames which + ;; are only minibuffers. + (let* ((new-surrogate + (car + (or (filtered-frame-list + (function + (lambda (frame) + (eq (cdr (assq 'minibuffer + (frame-parameters frame))) + 'only)))) + (minibuffer-frame-list)))) + (new-minibuffer (minibuffer-window new-surrogate))) + + (if (eq default-minibuffer-frame frame-initial-frame) + (setq default-minibuffer-frame new-surrogate)) + + ;; Wean the frames using frame-initial-frame as + ;; their minibuffer frame. + (mapcar + (function + (lambda (frame) + (modify-frame-parameters + frame (list (cons 'minibuffer new-minibuffer))))) + users-of-initial)))) + + ;; Redirect events enqueued at this frame to the new frame. + ;; Is this a good idea? + (redirect-frame-focus frame-initial-frame new) + + ;; Finally, get rid of the old frame. + (delete-frame frame-initial-frame t)) + + ;; Otherwise, we don't need all that rigamarole; just apply + ;; the new parameters. + (let (newparms allparms tail) + (setq allparms (append initial-frame-alist + default-frame-alist nil)) + (if (assq 'height frame-initial-geometry-arguments) + (setq allparms (assq-delete-all 'height allparms))) + (if (assq 'width frame-initial-geometry-arguments) + (setq allparms (assq-delete-all 'width allparms))) + (if (assq 'left frame-initial-geometry-arguments) + (setq allparms (assq-delete-all 'left allparms))) + (if (assq 'top frame-initial-geometry-arguments) + (setq allparms (assq-delete-all 'top allparms))) + (setq tail allparms) + ;; Find just the parms that have changed since we first + ;; made this frame. Those are the ones actually set by + ;; the init file. For those parms whose values we already knew + ;; (such as those spec'd by command line options) + ;; it is undesirable to specify the parm again + ;; once the user has seen the frame and been able to alter it + ;; manually. + (while tail + (let (newval oldval) + (setq oldval (assq (car (car tail)) + frame-initial-frame-alist)) + (setq newval (cdr (assq (car (car tail)) allparms))) + (or (and oldval (eq (cdr oldval) newval)) + (setq newparms + (cons (cons (car (car tail)) newval) newparms)))) + (setq tail (cdr tail))) + (setq newparms (nreverse newparms)) + (modify-frame-parameters frame-initial-frame + newparms) + ;; If we changed the background color, + ;; we need to update the background-mode parameter + ;; and maybe some faces too. + (when (assq 'background-color newparms) + (unless (assq 'background-mode newparms) + (frame-set-background-mode frame-initial-frame)) + (face-set-after-frame-default frame-initial-frame))))) ;; Restore the original buffer. (set-buffer old-buffer) @@ -415,6 +518,26 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;;;; Creation of additional frames, and other frame miscellanea +(defun modify-all-frames-parameters (alist) + "modify all current and future frames parameters according to ALIST. +This changes `default-frame-alist' and possibly `initial-frame-alist'. +See help of `modify-frame-parameters' for more information." + (let (element) ;; temp + (dolist (frame (frame-list)) + (modify-frame-parameters frame alist)) + + (dolist (pair alist) ;; conses to add/replace + ;; initial-frame-alist needs setting only when + ;; frame-notice-user-settings is true + (and frame-notice-user-settings + (setq element (assoc (car pair) initial-frame-alist)) + (setq initial-frame-alist (delq element initial-frame-alist))) + (and (setq element (assoc (car pair) default-frame-alist)) + (setq default-frame-alist (delq element default-frame-alist))))) + (and frame-notice-user-settings + (setq initial-frame-alist (append initial-frame-alist alist))) + (setq default-frame-alist (append default-frame-alist alist))) + (defun get-other-frame () "Return some frame other than the current frame. Create one if necessary. Note that the minibuffer frame, if separate, @@ -429,14 +552,16 @@ is not considered (see `next-frame')." (interactive) (select-window (next-window (selected-window) (> (minibuffer-depth) 0) - t))) + t)) + (select-frame-set-input-focus (selected-frame))) (defun previous-multiframe-window () "Select the previous window, regardless of which frame it is on." (interactive) (select-window (previous-window (selected-window) (> (minibuffer-depth) 0) - t))) + t)) + (select-frame-set-input-focus (selected-frame))) (defun make-frame-on-display (display &optional parameters) "Make a frame on display DISPLAY. @@ -460,11 +585,12 @@ The optional second argument PARAMETERS specifies additional frame parameters." "Functions to run after a frame is created. The functions are run with one arg, the newly created frame.") -(defvar after-setting-font-hooks nil +(defvar after-setting-font-hook nil "Functions to run after a frame's font has been changed.") ;; Alias, kept temporarily. (defalias 'new-frame 'make-frame) +(make-obsolete 'new-frame 'make-frame "21.4") (defun make-frame (&optional parameters) "Return a newly created frame displaying the current buffer. @@ -494,13 +620,13 @@ on `after-make-frame-functions' are run with one arg, the newly created frame." (defun filtered-frame-list (predicate) "Return a list of all live frames which satisfy PREDICATE." - (let ((frames (frame-list)) - good-frames) + (let* ((frames (frame-list)) + (list frames)) (while (consp frames) - (if (funcall predicate (car frames)) - (setq good-frames (cons (car frames) good-frames))) + (unless (funcall predicate (car frames)) + (setcar frames nil)) (setq frames (cdr frames))) - good-frames)) + (delq nil list))) (defun minibuffer-frame-list () "Return a list of all frames with their own minibuffers." @@ -512,12 +638,9 @@ on `after-make-frame-functions' are run with one arg, the newly created frame." "Return a list of all frames on DISPLAY. DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN. If DISPLAY is omitted or nil, it defaults to the selected frame's display." - (let* ((display (or display - (cdr (assoc 'display (frame-parameters))))) - (func - (function (lambda (frame) - (eq (cdr (assoc 'display (frame-parameters frame))) - display))))) + (let* ((display (or display (frame-parameter nil 'display))) + (func #'(lambda (frame) + (equal (frame-parameter frame 'display) display)))) (filtered-frame-list func))) (defun framep-on-display (&optional display) @@ -550,18 +673,38 @@ the user during startup." (nreverse frame-initial-geometry-arguments)) (cdr param-list)) - (defcustom focus-follows-mouse t - "*Non-nil if window system changes focus when you move the mouse." + "*Non-nil if window system changes focus when you move the mouse. +You should set this variable to tell Emacs how your window manager +handles focus, since there is no way in general for Emacs to find out +automatically." :type 'boolean :group 'frames :version "20.3") +(defun select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (select-frame frame) + (raise-frame frame) + ;; Ensure, if possible, that frame gets input focus. + (cond ((eq window-system 'x) + (x-focus-frame frame)) + ((eq window-system 'w32) + (w32-focus-frame frame))) + (cond (focus-follows-mouse + (set-mouse-position (selected-frame) (1- (frame-width)) 0)))) + (defun other-frame (arg) - "Select the ARG'th different visible frame, and raise it. + "Select the ARG'th different visible frame on current display, and raise it. All frames are arranged in a cyclic order. This command selects the frame ARG steps away in that order. -A negative ARG moves in the opposite order." +A negative ARG moves in the opposite order. + +To make this command work properly, you must tell Emacs +how the system (or the window manager) generally handles +focus-switching between windows. If moving the mouse onto a window +selects it (gives it focus), set `focus-follows-mouse' to t. +Otherwise, that variable should be nil." (interactive "p") (let ((frame (selected-frame))) (while (> arg 0) @@ -574,16 +717,14 @@ A negative ARG moves in the opposite order." (while (not (eq (frame-visible-p frame) t)) (setq frame (previous-frame frame))) (setq arg (1+ arg))) - (select-frame frame) - (raise-frame frame) - ;; Ensure, if possible, that frame gets input focus. - (cond ((eq window-system 'x) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when (and (not (eq window-system 'w32)) - focus-follows-mouse) - (set-mouse-position (selected-frame) (1- (frame-width)) 0)))) + (select-frame-set-input-focus frame))) + +(defun iconify-or-deiconify-frame () + "Iconify the selected frame, or deiconify if it's currently an icon." + (interactive) + (if (eq (cdr (assq 'visibility (frame-parameters))) t) + (iconify-frame) + (make-frame-visible))) (defun make-frame-names-alist () (let* ((current-frame (selected-frame)) @@ -599,7 +740,7 @@ A negative ARG moves in the opposite order." (defvar frame-name-history nil) (defun select-frame-by-name (name) - "Select the frame whose name is NAME and raise it. + "Select the frame on the current terminal whose name is NAME and raise it. If there is no frame by that name, signal an error." (interactive (let* ((frame-names-alist (make-frame-names-alist)) @@ -618,10 +759,12 @@ If there is no frame by that name, signal an error." (raise-frame frame) (select-frame frame) ;; Ensure, if possible, that frame gets input focus. - (if (eq window-system 'w32) - (w32-focus-frame frame) - (when focus-follows-mouse - (set-mouse-position (selected-frame) (1- (frame-width)) 0))))) + (cond ((eq window-system 'x) + (x-focus-frame frame)) + ((eq window-system 'w32) + (w32-focus-frame frame))) + (when focus-follows-mouse + (set-mouse-position frame (1- (frame-width frame)) 0)))) ;;;; Frame configurations @@ -680,11 +823,6 @@ is given and non-nil, the unwanted frames are iconified instead." ;;;; Convenience functions for accessing and interactively changing ;;;; frame parameters. -(defun frame-parameter (frame parameter) - "Return FRAME's value for parameter PARAMETER. -If FRAME is nil, describe the currently selected frame." - (cdr (assq parameter (frame-parameters frame)))) - (defun frame-height (&optional frame) "Return number of lines available for display on FRAME. If FRAME is omitted, describe the currently selected frame." @@ -696,16 +834,40 @@ If FRAME is omitted, describe the currently selected frame." (cdr (assq 'width (frame-parameters frame)))) (defalias 'set-default-font 'set-frame-font) -(defun set-frame-font (font-name) +(defun set-frame-font (font-name &optional keep-size) "Set the font of the selected frame to FONT-NAME. When called interactively, prompt for the name of the font to use. -To get the frame's current default font, use `frame-parameters'." - (interactive "sFont name: ") - (modify-frame-parameters (selected-frame) - (list (cons 'font font-name))) - ;; Update faces that want a bold or italic version of the default font. - (frame-update-faces (selected-frame)) - (run-hooks 'after-setting-font-hooks)) +To get the frame's current default font, use `frame-parameters'. + +The default behavior is to keep the numbers of lines and columns in +the frame, thus may change its pixel size. If optional KEEP-SIZE is +non-nil (interactively, prefix argument) the current frame size (in +pixels) is kept by adjusting the numbers of the lines and columns." + (interactive + (let* ((completion-ignore-case t) + (font (completing-read "Font name: " + (mapcar #'list + ;; x-list-fonts will fail with an error + ;; if this frame doesn't support fonts. + (x-list-fonts "*" nil (selected-frame))) + nil nil nil nil + (frame-parameter nil 'font)))) + (list font current-prefix-arg))) + (let (fht fwd) + (if keep-size + (setq fht (* (frame-parameter nil 'height) (frame-char-height)) + fwd (* (frame-parameter nil 'width) (frame-char-width)))) + (modify-frame-parameters (selected-frame) + (list (cons 'font font-name))) + (if keep-size + (modify-frame-parameters + (selected-frame) + (list (cons 'height (round fht (frame-char-height))) + (cons 'width (round fwd (frame-char-width))))))) + (run-hooks 'after-setting-font-hook 'after-setting-font-hooks)) + +(defun set-frame-parameter (frame parameter value) + (modify-frame-parameters frame (list (cons parameter value)))) (defun set-background-color (color-name) "Set the background color of the selected frame to COLOR-NAME. @@ -714,7 +876,8 @@ To get the frame's current background color, use `frame-parameters'." (interactive (list (facemenu-read-color))) (modify-frame-parameters (selected-frame) (list (cons 'background-color color-name))) - (frame-update-face-colors (selected-frame))) + (or window-system + (face-set-after-frame-default (selected-frame)))) (defun set-foreground-color (color-name) "Set the foreground color of the selected frame to COLOR-NAME. @@ -723,7 +886,8 @@ To get the frame's current foreground color, use `frame-parameters'." (interactive (list (facemenu-read-color))) (modify-frame-parameters (selected-frame) (list (cons 'foreground-color color-name))) - (frame-update-face-colors (selected-frame))) + (or window-system + (face-set-after-frame-default (selected-frame)))) (defun set-cursor-color (color-name) "Set the text cursor color of the selected frame to COLOR-NAME. @@ -791,6 +955,18 @@ one frame, otherwise the name is displayed on the frame's caption bar." (interactive "sFrame name: ") (modify-frame-parameters (selected-frame) (list (cons 'name name)))) + +(defun frame-current-scroll-bars (&optional frame) + "Return the current scroll-bar settings in frame FRAME. +Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the +current location of the vertical scroll-bars (left, right, or nil), +and HORISONTAL specifies the current location of the horisontal scroll +bars (top, bottom, or nil)." + (let ((vert (frame-parameter frame 'vertical-scroll-bars)) + (hor nil)) + (unless (memq vert '(left right nil)) + (setq vert default-frame-scroll-bars)) + (cons vert hor))) ;;;; Frame/display capabilities. (defun display-mouse-p (&optional display) @@ -831,6 +1007,18 @@ DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display)." (not (null (memq (framep-on-display display) '(x w32 mac))))) +(defun display-images-p (&optional display) + "Return non-nil if DISPLAY can display images. + +DISPLAY can be a display name, a frame, or nil (meaning the selected +frame's display)." + (and (display-graphic-p display) + (fboundp 'image-mask-p) + (fboundp 'image-size))) + +(defalias 'display-multi-frame-p 'display-graphic-p) +(defalias 'display-multi-font-p 'display-graphic-p) + (defun display-selections-p (&optional display) "Return non-nil if DISPLAY supports selections. A selection is a way to transfer text or other data between programs @@ -930,7 +1118,7 @@ the question is inapplicable to a certain kind of display." ((eq frame-type 'pc) 16) (t - (length (tty-color-alist)))))) + (tty-display-color-cells))))) (defun display-visual-class (&optional display) "Returns the visual class of DISPLAY. @@ -969,33 +1157,66 @@ should use `set-frame-height' instead." (defun delete-other-frames (&optional frame) "Delete all frames except FRAME. -FRAME nil or omitted means delete all frames except the selected frame." +If FRAME uses another frame's minibuffer, the minibuffer frame is +left untouched. FRAME nil or omitted means use the selected frame." (interactive) (unless frame (setq frame (selected-frame))) - (mapcar 'delete-frame (delq frame (frame-list)))) - - -(make-obsolete 'screen-height 'frame-height) -(make-obsolete 'screen-width 'frame-width) -(make-obsolete 'set-screen-width 'set-frame-width) -(make-obsolete 'set-screen-height 'set-frame-height) + (let* ((mini-frame (window-frame (minibuffer-window frame))) + (frames (delq mini-frame (delq frame (frame-list))))) + ;; Delete mon-minibuffer-only frames first, because `delete-frame' + ;; signals an error when trying to delete a mini-frame that's + ;; still in use by another frame. + (dolist (frame frames) + (unless (eq (frame-parameter frame 'minibuffer) 'only) + (delete-frame frame))) + ;; Delete minibuffer-only frames. + (dolist (frame frames) + (when (eq (frame-parameter frame 'minibuffer) 'only) + (delete-frame frame))))) + +(make-obsolete 'screen-height 'frame-height) ;before 19.15 +(make-obsolete 'screen-width 'frame-width) ;before 19.15 +(make-obsolete 'set-screen-width 'set-frame-width) ;before 19.15 +(make-obsolete 'set-screen-height 'set-frame-height) ;before 19.15 + +;; miscellaneous obsolescence declarations +(defvaralias 'delete-frame-hook 'delete-frame-functions) +(make-obsolete-variable 'delete-frame-hook 'delete-frame-functions "21.4") -;;; Highlighting trailing whitespace. +;; Highlighting trailing whitespace. (make-variable-buffer-local 'show-trailing-whitespace) (defcustom show-trailing-whitespace nil - "*Non-nil means highlight trailing whitespace in face `trailing-whitespace'." + "*Non-nil means highlight trailing whitespace in face `trailing-whitespace'. + +Setting this variable makes it local to the current buffer." :tag "Highlight trailing whitespace." - :set #'(lambda (symbol value) (set-default symbol value)) :type 'boolean :group 'font-lock) -;;; Blinking cursor +;; Scrolling + +(defgroup scrolling nil + "Scrolling windows." + :version "21.1" + :group 'frames) + +(defcustom auto-hscroll-mode t + "*Allow or disallow automatic scrolling windows horizontally. +If non-nil, windows are automatically scrolled horizontally to make +point visible." + :version "21.1" + :type 'boolean + :group 'scrolling) +(defvaralias 'automatic-hscrolling 'auto-hscroll-mode) + + +;; Blinking cursor (defgroup cursor nil "Displaying text cursors." @@ -1027,9 +1248,13 @@ This timer calls `blink-cursor' every `blink-cursor-interval' seconds.") (defun blink-cursor-mode (arg) "Toggle blinking cursor mode. -With arg, turn blinking cursor mode on iff arg is positive. +With a numeric argument, turn blinking cursor mode on iff ARG is positive. When blinking cursor mode is enabled, the cursor of the selected -window blinks." +window blinks. + +Note that this command is effective only when Emacs +displays through a window system, because then Emacs does its own +cursor display. On a text-only terminal, this is not implemented." (interactive "P") (let ((on-p (if (null arg) (not blink-cursor-mode) @@ -1044,7 +1269,7 @@ window blinks." (if on-p (progn ;; Hide the cursor. - (internal-show-cursor nil nil) + ;(internal-show-cursor nil nil) (setq blink-cursor-idle-timer (run-with-idle-timer blink-cursor-delay blink-cursor-delay @@ -1052,11 +1277,14 @@ window blinks." (setq blink-cursor-mode t)) (internal-show-cursor nil t)))) -(defcustom blink-cursor (not (eq system-type 'ms-dos)) +;; Note that this is really initialized from startup.el before +;; the init-file is read. + +(defcustom blink-cursor nil "*Non-nil means blinking cursor mode is active." + :group 'cursor :tag "Blinking cursor" :type 'boolean - :group 'cursor :set #'(lambda (symbol value) (set-default symbol value) (blink-cursor-mode (or value 0)))) @@ -1079,7 +1307,7 @@ command starts, by installing a pre-command hook." (defun blink-cursor-end () "Stop cursor blinking. This is installed as a pre-command hook by `blink-cursor-start'. -When run, it cancels the timer `blink-cursor-timer' and removes +When run, it cancels the timer `blink-cursor-timer' and removes itself as a pre-command hook." (remove-hook 'pre-command-hook 'blink-cursor-end) (internal-show-cursor nil t) @@ -1088,41 +1316,32 @@ itself as a pre-command hook." -;;; Busy-cursor. +;; Hourglass pointer -(defcustom busy-cursor t - "*Non-nil means show a busy-cursor when running under a window system." - :tag "Busy-cursor" +(defcustom display-hourglass t + "*Non-nil means show an hourglass pointer when running under a window system." + :tag "Hourglass pointer" :type 'boolean - :group 'cursor - :get #'(lambda (symbol) display-busy-cursor) - :set #'(lambda (symbol value) - (set-default symbol value) - (setq display-busy-cursor value))) + :group 'cursor) -(defcustom busy-cursor-delay-seconds 1 - "*Seconds to wait before displaying a busy-cursor." - :tag "Busy-cursor delay" +(defcustom hourglass-delay 1 + "*Seconds to wait before displaying an hourglass pointer." + :tag "Hourglass delay" :type 'number - :group 'cursor - :get #'(lambda (symbol) busy-cursor-delay) - :set #'(lambda (symbol value) - (set-default symbol value) - (setq busy-cursor-delay value))) + :group 'cursor) -(defcustom show-cursor-in-non-selected-windows t +(defcustom cursor-in-non-selected-windows t "*Non-nil means show a hollow box cursor in non-selected-windows. -If nil, don't show a cursor except in the selected window." +If nil, don't show a cursor except in the selected window. +Use Custom to set this variable to get the display updated." :tag "Cursor in non-selected windows" :type 'boolean :group 'cursor - :get #'(lambda (symbol) cursor-in-non-selected-windows) :set #'(lambda (symbol value) (set-default symbol value) - (setq cursor-in-non-selected-windows value) (force-mode-line-update t))) - + ;;;; Key bindings @@ -1133,5 +1352,5 @@ If nil, don't show a cursor except in the selected window." (provide 'frame) +;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56 ;;; frame.el ends here -(frame-notice-user-settings):