;;; frame.el --- multi-frame management independent of window systems.
-;; Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(error
"Can't create multiple frames without a window system"))))))))
+(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.
"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. For some reason, menu-bar-mode is not bound
+ ;; in this case, but tool-bar-mode is.
+ (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
;; window is the minibuffer.
(let ((old-buffer (current-buffer)))
+ (when (and frame-notice-user-settings
+ (null frame-initial-frame))
+ ;; 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
+ (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)
;; when we first made the frame.
(setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
(if (assq 'height frame-initial-geometry-arguments)
- (setq parms (assoc-delete-all 'height parms)))
+ (setq parms (assq-delete-all 'height parms)))
(if (assq 'width frame-initial-geometry-arguments)
- (setq parms (assoc-delete-all 'width parms)))
+ (setq parms (assq-delete-all 'width parms)))
(if (assq 'left frame-initial-geometry-arguments)
- (setq parms (assoc-delete-all 'left parms)))
+ (setq parms (assq-delete-all 'left parms)))
(if (assq 'top frame-initial-geometry-arguments)
- (setq parms (assoc-delete-all 'top parms)))
+ (setq parms (assq-delete-all 'top parms)))
(setq new
(make-frame
;; Use the geometry args that created the existing
;; the new parameters.
(let (newparms allparms tail)
(setq allparms (append initial-frame-alist
- default-frame-alist))
+ default-frame-alist nil))
(if (assq 'height frame-initial-geometry-arguments)
- (setq allparms (assoc-delete-all 'height allparms)))
+ (setq allparms (assq-delete-all 'height allparms)))
(if (assq 'width frame-initial-geometry-arguments)
- (setq allparms (assoc-delete-all 'width allparms)))
+ (setq allparms (assq-delete-all 'width allparms)))
(if (assq 'left frame-initial-geometry-arguments)
- (setq allparms (assoc-delete-all 'left allparms)))
+ (setq allparms (assq-delete-all 'left allparms)))
(if (assq 'top frame-initial-geometry-arguments)
- (setq allparms (assoc-delete-all 'top allparms)))
+ (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
(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)))))
+ (face-set-after-frame-default frame-initial-frame)))))
;; Restore the original buffer.
(set-buffer old-buffer)
;; Make sure the initial frame can be GC'd if it is ever deleted.
;; Make sure frame-notice-user-settings does nothing if called twice.
+ (setq frame-notice-user-settings nil)
(setq frame-initial-frame nil)))
(defun make-initial-minibuffer-frame (display)
"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.
(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."
(function (lambda (frame)
(eq frame (window-frame (minibuffer-window frame)))))))
+(defun frames-on-display-list (&optional display)
+ "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 (frame-parameter nil 'display)))
+ (func #'(lambda (frame)
+ (eq (frame-parameter frame 'display) display))))
+ (filtered-frame-list func)))
+
+(defun framep-on-display (&optional display)
+ "Return the type of frames on DISPLAY.
+DISPLAY may be a display name or a frame. If it is a frame, its type is
+returned.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+All frames on a given display are of the same type."
+ (or (framep display)
+ (framep (car (frames-on-display-list display)))))
+
(defun frame-remove-geometry-params (param-list)
"Return the parameter list PARAM-LIST, but with geometry specs removed.
This deletes all bindings in PARAM-LIST for `top', `left', `width',
(while (not (eq (frame-visible-p frame) t))
(setq frame (previous-frame frame)))
(setq arg (1+ arg)))
- (raise-frame frame)
(select-frame frame)
+ (raise-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)))))
+ (when (eq window-system 'w32)
+ (w32-focus-frame frame))
+ (cond (focus-follows-mouse
+ (unless (eq window-system 'w32)
+ (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
+ (t
+ (when (eq window-system 'x)
+ (x-focus-frame frame))))))
(defun make-frame-names-alist ()
(let* ((current-frame (selected-frame))
;;;; 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."
"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: ")
+ (interactive
+ (list
+ (let ((completion-ignore-case t))
+ (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)))))))
(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))
+ (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
(defun set-background-color (color-name)
"Set the background color of the selected frame to COLOR-NAME.
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)))
+ (list (cons 'background-color color-name))))
(defun set-foreground-color (color-name)
"Set the foreground color of the selected frame to COLOR-NAME.
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)))
+ (list (cons 'foreground-color color-name))))
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
(modify-frame-parameters (selected-frame)
(list (cons 'name name))))
\f
+;;;; Frame/display capabilities.
+(defun display-mouse-p (&optional display)
+ "Return non-nil if DISPLAY has a mouse available.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((eq frame-type 'pc)
+ (msdos-mouse-p))
+ ((eq system-type 'windows-nt)
+ (> w32-num-mouse-buttons 0))
+ ((memq frame-type '(x mac))
+ t) ;; We assume X and Mac *always* have a pointing device
+ (t
+ (or (and (featurep 'xt-mouse)
+ xterm-mouse-mode)
+ ;; t-mouse is distributed with the GPM package. It doesn't have
+ ;; a toggle.
+ (featurep 't-mouse))))))
+
+(defun display-popup-menus-p (&optional display)
+ "Return non-nil if popup menus are supported on DISPLAY.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display).
+Support for popup menus requires that the mouse be available."
+ (and
+ (let ((frame-type (framep-on-display display)))
+ (memq frame-type '(x w32 pc mac)))
+ (display-mouse-p display)))
+
+(defun display-graphic-p (&optional display)
+ "Return non-nil if DISPLAY is a graphic display.
+Graphical displays are those which are capable of displaying several
+frames and several different fonts at once. This is true for displays
+that use a window system such as X, and false for text-only terminals.
+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)))))
+
+(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
+via special system buffers called `selection' or `cut buffer' or
+`clipboard'.
+DISPLAY can be a display name, a frame, or nil (meaning the selected
+frame's display)."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((eq frame-type 'pc)
+ ;; MS-DOG frames support selections when Emacs runs inside
+ ;; the Windows' DOS Box.
+ (not (null dos-windows-version)))
+ ((memq frame-type '(x w32 mac))
+ t) ;; FIXME?
+ (t
+ nil))))
+
+(defun display-screens (&optional display)
+ "Return the number of screens associated with DISPLAY."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32))
+ (x-display-screens display))
+ (t ;; FIXME: is this correct for the Mac?
+ 1))))
+
+(defun display-pixel-height (&optional display)
+ "Return the height of DISPLAY's screen in pixels.
+For character terminals, each character counts as a single pixel."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-pixel-height display))
+ (t
+ (frame-height (if (framep display) display (selected-frame)))))))
+
+(defun display-pixel-width (&optional display)
+ "Return the width of DISPLAY's screen in pixels.
+For character terminals, each character counts as a single pixel."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-pixel-width display))
+ (t
+ (frame-width (if (framep display) display (selected-frame)))))))
+
+(defun display-mm-height (&optional display)
+ "Return the height of DISPLAY's screen in millimeters.
+If the information is unavailable, value is nil."
+ (and (memq (framep-on-display display) '(x w32 mac))
+ (x-display-mm-height display)))
+
+(defun display-mm-width (&optional display)
+ "Return the width of DISPLAY's screen in millimeters.
+If the information is unavailable, value is nil."
+ (and (memq (framep-on-display display) '(x w32 mac))
+ (x-display-mm-width display)))
+
+(defun display-backing-store (&optional display)
+ "Return the backing store capability of DISPLAY's screen.
+The value may be `always', `when-mapped', `not-useful', or nil if
+the question is inapplicable to a certain kind of display."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-backing-store display))
+ (t
+ 'not-useful))))
+
+(defun display-save-under (&optional display)
+ "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-save-under display))
+ (t
+ 'not-useful))))
+
+(defun display-planes (&optional display)
+ "Return the number of planes supported by DISPLAY."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-planes display))
+ ((eq frame-type 'pc)
+ 4)
+ (t
+ (truncate (log (length (tty-color-alist)) 2))))))
+
+(defun display-color-cells (&optional display)
+ "Return the number of color cells supported by DISPLAY."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-color-cells display))
+ ((eq frame-type 'pc)
+ 16)
+ (t
+ (length (tty-color-alist))))))
+
+(defun display-visual-class (&optional display)
+ "Returns the visual class of DISPLAY.
+The value is one of the symbols `static-gray', `gray-scale',
+`static-color', `pseudo-color', `true-color', or `direct-color'."
+ (let ((frame-type (framep-on-display display)))
+ (cond
+ ((memq frame-type '(x w32 mac))
+ (x-display-visual-class display))
+ ((and (memq frame-type '(pc t))
+ (tty-display-color-p display))
+ 'static-color)
+ (t
+ 'static-gray))))
+
+\f
;;;; Aliases for backward compatibility with Emacs 18.
(defalias 'screen-height 'frame-height)
(defalias 'screen-width 'frame-width)
should use `set-frame-height' instead."
(set-frame-height (selected-frame) lines pretend))
-(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)
+(defun delete-other-frames (&optional frame)
+ "Delete all frames except FRAME.
+FRAME nil or omitted means delete all frames except the selected frame."
+ (interactive)
+ (unless frame
+ (setq frame (selected-frame)))
+ (mapcar 'delete-frame (delq frame (frame-list))))
+
+
+(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
\f
;;; Highlighting trailing whitespace.
:group 'font-lock)
+\f
+;;; Scrolling
+
+(defgroup scrolling nil
+ "Scrolling windows."
+ :version "21.1"
+ :group 'frames)
+
+(defcustom automatic-hscrolling t
+ "*Allow or disallow autmatic scrolling windows horizontally.
+If non-nil, windows are automatically scrolled horizontally to make
+point visible."
+ :version "21.1"
+ :type 'boolean
+ :group 'scrolling)
+
\f
;;; Blinking cursor
(defgroup cursor nil
- "Cursor on frames."
+ "Displaying text cursors."
:version "21.1"
:group 'frames)
(defcustom blink-cursor-delay 0.5
- "*Seconds of Emacs idle time after which cursor starts to blink."
+ "*Seconds of idle time after which cursor starts to blink."
:tag "Delay in seconds."
:type 'number
:group 'cursor)
:group 'cursor)
(defvar blink-cursor-idle-timer nil
- "Timer started after blink-cursor-delay seconds of Emacs idle time.
-The function blink-cursor-start is called when the timer fires.")
+ "Timer started after `blink-cursor-delay' seconds of Emacs idle time.
+The function `blink-cursor-start' is called when the timer fires.")
(defvar blink-cursor-timer nil
- "Time started from blink-cursor-start. This timer calls blink-cursor
-every blink-cursor-interval seconds.")
+ "Timer started from `blink-cursor-start'.
+This timer calls `blink-cursor' every `blink-cursor-interval' seconds.")
(defvar blink-cursor-mode nil
"Non-nil means blinking cursor is active.")
(if on-p
(progn
;; Hide the cursor.
- (show-cursor 0)
+ ;(internal-show-cursor nil nil)
(setq blink-cursor-idle-timer
(run-with-idle-timer blink-cursor-delay
blink-cursor-delay
'blink-cursor-start))
- (setq blink-cursor-mode t)))))
+ (setq blink-cursor-mode t))
+ (internal-show-cursor nil t))))
-(defcustom blink-cursor (not (eq system-type 'ms-dos))
- "*Non-nil means blink-cursor-mode is active."
+;; 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))))
(defun blink-cursor-start ()
- "Timer function called from timer blink-cursor-idle-timer.
-Starts the timer blink-cursor-timer which lets the cursor blink
-if the selected frame has a non-nil `cursor-blinking' frame parameter.
-Arranges to cancel that timer by installing a pre command hook."
+ "Timer function called from the timer `blink-cursor-idle-timer'.
+This starts the timer `blink-cursor-timer', which makes the cursor blink
+if appropriate. It also arranges to cancel that timer when the next
+command starts, by installing a pre-command hook."
(when (null blink-cursor-timer)
(add-hook 'pre-command-hook 'blink-cursor-end)
(setq blink-cursor-timer
(run-with-timer blink-cursor-interval blink-cursor-interval
- 'show-cursor))))
+ 'blink-cursor-timer-function))))
+
+(defun blink-cursor-timer-function ()
+ "Timer function of timer `blink-cursor-timer'."
+ (internal-show-cursor nil (not (internal-show-cursor-p))))
(defun blink-cursor-end ()
"Stop cursor blinking.
-Installed as a pre-command hook by blink-cursor-start. Cancels
-the timer blink-cursor-timer and removes itself from the hook."
+This is installed as a pre-command hook by `blink-cursor-start'.
+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)
- (show-cursor 0)
+ (internal-show-cursor nil t)
(cancel-timer blink-cursor-timer)
(setq blink-cursor-timer nil))
;;; Busy-cursor.
(defcustom busy-cursor t
- "*Non-nil means show a busy-cursor when running under a window-system."
+ "*Non-nil means show a busy-cursor when running under a window system."
:tag "Busy-cursor"
:type 'boolean
:group 'cursor
(set-default symbol value)
(setq display-busy-cursor value)))
+(defcustom busy-cursor-delay-seconds 1
+ "*Seconds to wait before displaying a busy-cursor."
+ :tag "Busy-cursor delay"
+ :type 'number
+ :group 'cursor
+ :get #'(lambda (symbol) busy-cursor-delay)
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (setq busy-cursor-delay value)))
+\f
+(defcustom show-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.
+Setting this variable directly has no effect; use custom instead."
+ :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)))
+
\f
;;;; Key bindings
(define-key ctl-x-5-map "2" 'make-frame-command)
+(define-key ctl-x-5-map "1" 'delete-other-frames)
(define-key ctl-x-5-map "0" 'delete-frame)
(define-key ctl-x-5-map "o" 'other-frame)
(provide 'frame)
;;; frame.el ends here
-(frame-notice-user-settings):