diff options
Diffstat (limited to 'lisp/frame.el')
| -rw-r--r-- | lisp/frame.el | 190 |
1 files changed, 97 insertions, 93 deletions
diff --git a/lisp/frame.el b/lisp/frame.el index c77df558da8..1d5bbf2317e 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,4 +1,4 @@ -;;; 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-2015 Free Software ;; Foundation, Inc. @@ -27,21 +27,39 @@ ;;; 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 `window-system) + `(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 nil ,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 @@ -149,12 +167,6 @@ This function runs the hook `focus-out-hook'." ;; 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) @@ -181,10 +193,6 @@ This function runs the hook `focus-out-hook'." (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)) @@ -263,59 +271,45 @@ there (in decreasing order of priority)." ;; 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* ((init-lines + (assq 'tool-bar-lines initial-frame-alist)) + (other-lines + (or (assq 'tool-bar-lines window-system-frame-alist) + (assq 'tool-bar-lines default-frame-alist))) + (lines (or init-lines other-lines)) + (height (tool-bar-height frame-initial-frame t))) + ;; Adjust frame top if either zero (nil) tool bar lines have + ;; been requested in the most relevant of the frame's alists + ;; or tool bar mode has been explicitly turned off in the + ;; user's init file. + (when (and (> height 0) + (or (and lines + (or (null (cdr lines)) + (eq 0 (cdr lines)))) + (not tool-bar-mode))) + (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) + (cond + ((and (consp top) (eq '+ (car top))) + (list '+ (+ (cadr top) height))) + ((and (consp top) (eq '- (car top))) + (list '- (- (cadr top) height))) + (t (+ top height))))) + (modify-frame-parameters + frame-initial-frame `((top . ,adjusted-top)))))) + ;; Reset `tool-bar-mode' when zero tool bar lines have been + ;; requested for the window-system or default frame alists. + (when (and tool-bar-mode + (and other-lines + (or (null (cdr other-lines)) + (eq 0 (cdr other-lines))))) (tool-bar-mode -1))))) ;; The initial frame we create above always has a minibuffer. @@ -657,29 +651,27 @@ the new frame according to its own rules." (interactive) (let* ((display (cdr (assq 'display parameters))) (w (cond - ((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)))) - (t type)))) - ((assq 'window-system parameters) - (cdr (assq 'window-system parameters))) + ((assq 'terminal parameters) + (let ((type (terminal-live-p + (cdr (assq 'terminal parameters))))) + (cond + ((eq t type) nil) + ((null type) (error "Terminal %s does not exist" + (cdr (assq 'terminal parameters)))) + (t type)))) + ((assq 'window-system parameters) + (cdr (assq 'window-system parameters))) (display (or (window-system-for-display display) (error "Don't know how to interpret display %S" display))) - (t window-system))) - (frame-creation-function (cdr (assq w frame-creation-function-alist))) + (t window-system))) (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)) @@ -693,13 +685,23 @@ the new frame according to its own rules." (push p params))) ;; Now make the frame. (run-hooks 'before-make-frame-hook) - (setq frame (funcall frame-creation-function params)) + +;; (setq frame-adjust-size-history '(t)) + + (setq frame + (funcall (gui-method frame-creation-function w) params)) (normal-erase-is-backspace-setup-frame frame) ;; Inherit the original frame's parameters. (dolist (param frame-inherited-parameters) (unless (assq param parameters) ;Overridden by explicit parameters. (let ((val (frame-parameter oldframe param))) (when val (set-frame-parameter frame param val))))) + + (when (eq (car frame-adjust-size-history) t) + (setq frame-adjust-size-history + (cons t (cons (list "Frame made") + (cdr frame-adjust-size-history))))) + (run-hook-with-args 'after-make-frame-functions frame) frame)) @@ -1276,16 +1278,18 @@ On graphical displays, it is displayed on the frame's title bar." (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 . HORIZ0NTAL) where VERTICAL specifies the -current location of the vertical scroll-bars (left, right, or nil), -and HORIZONTAL specifies the current location of the horizontal 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))) + "Return the current scroll-bar types for frame FRAME. +Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies +the current location of the vertical scroll-bars (`left', `right' +or nil), and HORIZONTAL specifies the current location of the +horizontal scroll bars (`bottom' or nil). FRAME must specify a +live frame and defaults to the selected one." + (let* ((frame (window-normalize-frame frame)) + (vertical (frame-parameter frame 'vertical-scroll-bars)) + (horizontal (frame-parameter frame 'horizontal-scroll-bars))) + (unless (memq vertical '(left right nil)) + (setq vertical default-frame-scroll-bars)) + (cons vertical (and horizontal 'bottom)))) (defun frame-monitor-attributes (&optional frame) "Return the attributes of the physical monitor dominating FRAME. @@ -1368,8 +1372,8 @@ 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. + ;; 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)) |