-;;; frame.el --- multi-frame management independent of window systems
+;;; frame.el --- multi-frame management independent of window systems -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 1996-1997, 2000-2014 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2014 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;;; Code:
(eval-when-compile (require 'cl-lib))
-(defvar frame-creation-function-alist
- (list (cons nil
- (if (fboundp 'tty-create-frame-with-faces)
- 'tty-create-frame-with-faces
- (lambda (_parameters)
- (error "Can't create multiple frames without a window system")))))
- "Alist of window-system dependent functions to call to create a new frame.
+;; Dispatch tables for GUI methods.
+
+(defun gui-method--name (base)
+ (intern (format "%s-alist" base)))
+
+(defmacro gui-method (name &optional type)
+ (macroexp-let2 nil type (or type `(framep (selected-frame)))
+ `(alist-get ,type ,(gui-method--name name)
+ (lambda (&rest _args)
+ (error "No method %S for %S frame" ',name ,type)))))
+
+(defmacro gui-method-define (name type fun)
+ `(setf (gui-method ,name ',type) ,fun))
+
+(defmacro gui-method-declare (name &optional tty-fun doc)
+ (declare (doc-string 3) (indent 2))
+ `(defvar ,(gui-method--name name)
+ ,(if tty-fun `(list (cons t ,tty-fun))) ,doc))
+
+(defmacro gui-call (name &rest args)
+ `(funcall (gui-method ,name) ,@args))
+
+(gui-method-declare frame-creation-function
+ #'tty-create-frame-with-faces
+ "Method for window-system dependent functions to create a new frame.
The window system startup file should add its frame creation
-function to this list, which should take an alist of parameters
+function to this method, which should take an alist of parameters
as its argument.")
(defvar window-system-default-frame-alist nil
"Window-system dependent default frame parameters.
The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
-where WINDOW-SYSTEM is a window system symbol (see `window-system')
+where WINDOW-SYSTEM is a window system symbol (as returned by `framep')
and ALIST is a frame parameter alist like `default-frame-alist'.
Then, for frames on WINDOW-SYSTEM, any parameters specified in
ALIST supersede the corresponding parameters specified in
;; 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.
-;; Actually using hooks within Emacs is bad for future maintenance. --rms.
-;; (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.
(defvar frame-initial-frame nil)
(progn
(setq frame-initial-frame-alist
(append initial-frame-alist default-frame-alist nil))
- (or (assq 'horizontal-scroll-bars frame-initial-frame-alist)
- (setq frame-initial-frame-alist
- (cons '(horizontal-scroll-bars . t)
- frame-initial-frame-alist)))
(setq frame-initial-frame-alist
(cons (cons 'window-system initial-window-system)
frame-initial-frame-alist))
;; If the initial frame is still around, apply initial-frame-alist
;; and default-frame-alist to it.
(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 window-system-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)))
+ (let ((tool-bar-lines
+ (or (assq 'tool-bar-lines initial-frame-alist)
+ (assq 'tool-bar-lines window-system-frame-alist)
+ (assq 'tool-bar-lines default-frame-alist))))
+ ;; Shrink frame by its initial tool bar height iff either zero
+ ;; tool bar lines have been requested in one of the frame's
+ ;; alists or tool bar mode has been turned off explicitly in
+ ;; the user's init file.
+ (when (and tool-bar-lines
+ (> frame-initial-frame-tool-bar-height 0)
+ (or (not tool-bar-mode)
+ (null (cdr tool-bar-lines))
+ (eq 0 (cdr tool-bar-lines))))
+ (set-frame-height
+ frame-initial-frame (- (frame-text-height frame-initial-frame)
+ frame-initial-frame-tool-bar-height)
+ nil t)
+ (let* ((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)))))
+ (cond
+ ((and (consp top) (eq '+ (car top)))
+ (list '+ (+ (cadr top)
+ frame-initial-frame-tool-bar-height)))
+ ((and (consp top) (eq '- (car top)))
+ (list '- (- (cadr top)
+ frame-initial-frame-tool-bar-height)))
+ (t (+ top frame-initial-frame-tool-bar-height)))))
+ (modify-frame-parameters
+ frame-initial-frame '((top . adjusted-top))))))
+ (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
((assq 'terminal parameters)
(let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
(cond
- ((eq type t) nil)
- ((eq type nil) (error "Terminal %s does not exist"
- (cdr (assq 'terminal parameters))))
+ ((null type) (error "Terminal %s does not exist"
+ (cdr (assq 'terminal parameters))))
(t type))))
((assq 'window-system parameters)
(cdr (assq 'window-system parameters)))
(error "Don't know how to interpret display %S"
display)))
(t window-system)))
- (frame-creation-function (cdr (assq w frame-creation-function-alist)))
(oldframe (selected-frame))
(params parameters)
frame)
- (unless frame-creation-function
- (error "Don't know how to create a frame on window system %s" w))
(unless (get w 'window-system-initialized)
- (funcall (cdr (assq w window-system-initialization-alist)) display)
+ (funcall (gui-method window-system-initialization w) display)
(setq x-display-name display)
(put w 'window-system-initialized t))
(push p params)))
;; Now make the frame.
(run-hooks 'before-make-frame-hook)
- (setq frame (funcall frame-creation-function params))
+ (setq frame
+ (funcall (gui-method frame-creation-function (or w t)) params))
(normal-erase-is-backspace-setup-frame frame)
;; Inherit the original frame's parameters.
(dolist (param frame-inherited-parameters)
(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.
+ ;; MS-DOS frames support selections when Emacs runs inside
+ ;; a Windows DOS Box.
(with-no-warnings
(not (null dos-windows-version))))
((memq frame-type '(x w32 ns))