;;; Code:
(eval-when-compile (require 'cl-lib))
-;; 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
+(cl-defgeneric frame-creation-function (params)
"Method for window-system dependent functions to create a new frame.
The window system startup file should add its frame creation
function to this method, which should take an alist of parameters
as its argument.")
+(cl-defmethod frame-creation-function (params
+ &context (window-system (eql nil)))
+ ;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
+ ;; this method (i.e. move this method to faces.el), but faces.el is loaded
+ ;; much earlier from loadup.el (before cl-generic and even before
+ ;; cl-preloaded), so we'd first have to reorder that part.
+ (tty-create-frame-with-faces params))
+
(defvar window-system-default-frame-alist nil
"Window-system dependent default frame parameters.
The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
"Non-nil means function `frame-notice-user-settings' wasn't run yet.")
(declare-function tool-bar-mode "tool-bar" (&optional arg))
+(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
(defalias 'tool-bar-lines-needed 'tool-bar-height)
(let ((newparms (frame-parameters))
(frame (selected-frame)))
(tty-handle-reverse-video frame newparms)
+ ;; tty-handle-reverse-video might change the frame's
+ ;; color parameters, and we need to use the updated
+ ;; value below.
+ (setq newparms (frame-parameters))
;; If we changed the background color, we need to update
;; the background-mode parameter, and maybe some faces,
;; too.
(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))))))
+ (face-set-after-frame-default frame newparms))))))
;; If the initial frame is still around, apply initial-frame-alist
;; and default-frame-alist to it.
;; 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))))
- ;; 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* ((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)))
(let ((adjusted-top
(cond
((and (consp top) (eq '+ (car top)))
- (list '+ (+ (cadr top)
- frame-initial-frame-tool-bar-height)))
+ (list '+ (+ (cadr top) height)))
((and (consp top) (eq '- (car top)))
- (list '- (- (cadr top)
- frame-initial-frame-tool-bar-height)))
- (t (+ top frame-initial-frame-tool-bar-height)))))
+ (list '- (- (cadr top) height)))
+ (t (+ top height)))))
(modify-frame-parameters
frame-initial-frame `((top . ,adjusted-top))))))
- (tool-bar-mode -1))))
+ ;; 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.
;; If the user wants to remove it, or make it a minibuffer-only
(frame-set-background-mode frame-initial-frame))
(face-set-after-frame-default frame-initial-frame)
(setq newparms (delq new-bg newparms)))
+
+ (when (numberp (car frame-size-history))
+ (setq frame-size-history
+ (cons (1- (car frame-size-history))
+ (cons
+ (list frame-initial-frame
+ "frame-notice-user-settings"
+ nil newparms)
+ (cdr frame-size-history)))))
+
(modify-frame-parameters frame-initial-frame newparms)))))
;; Restore the original buffer.
Return nil if we don't know how to interpret DISPLAY."
;; MS-Windows doesn't know how to create a GUI frame in a -nw session.
(if (and (eq system-type 'windows-nt)
- (null (window-system)))
+ (null (window-system))
+ (not (daemonp)))
nil
(cl-loop for descriptor in display-format-alist
for pattern = (car descriptor)
frame)
(unless (get w 'window-system-initialized)
- (funcall (gui-method window-system-initialization w) display)
+ (let ((window-system w)) ;Hack attack!
+ (window-system-initialization 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 (gui-method frame-creation-function w) params))
+
+;; (setq frame-size-history '(1000))
+
+ (setq frame (let ((window-system w)) ;Hack attack!
+ (frame-creation-function 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 (numberp (car frame-size-history))
+ (setq frame-size-history
+ (cons (1- (car frame-size-history))
+ (cons (list frame "make-frame")
+ (cdr frame-size-history)))))
+
+ ;; We can run `window-configuration-change-hook' for this frame now.
+ (frame-after-make-frame frame t)
(run-hook-with-args 'after-make-frame-functions frame)
frame))
(modify-frame-parameters (selected-frame)
(list (cons 'background-color color-name)))
(or window-system
- (face-set-after-frame-default (selected-frame))))
+ (face-set-after-frame-default (selected-frame)
+ (list
+ (cons 'background-color color-name)
+ ;; Pass the foreground-color as
+ ;; well, if defined, to avoid
+ ;; losing it when faces are reset
+ ;; to their defaults.
+ (assq 'foreground-color
+ (frame-parameters))))))
(defun set-foreground-color (color-name)
"Set the foreground color of the selected frame to COLOR-NAME.
(modify-frame-parameters (selected-frame)
(list (cons 'foreground-color color-name)))
(or window-system
- (face-set-after-frame-default (selected-frame))))
+ (face-set-after-frame-default (selected-frame)
+ (list
+ (cons 'foreground-color color-name)
+ ;; Pass the background-color as
+ ;; well, if defined, to avoid
+ ;; losing it when faces are reset
+ ;; to their defaults.
+ (assq 'background-color
+ (frame-parameters))))))
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
(defun blink-cursor-timer-function ()
"Timer function of timer `blink-cursor-timer'."
(internal-show-cursor nil (not (internal-show-cursor-p)))
+ ;; Suspend counting blinks when the w32 menu-bar menu is displayed,
+ ;; since otherwise menu tooltips will behave erratically.
+ (or (and (fboundp 'w32--menu-bar-in-use)
+ (w32--menu-bar-in-use))
+ (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)))
;; Each blink is two calls to this function.
- (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done))
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
(blink-cursor-suspend)
;; Frame maximization/fullscreen
(defun toggle-frame-maximized ()
- "Toggle maximization state of the selected frame.
-Maximize the selected frame or un-maximize if it is already maximized.
-Respect window manager screen decorations.
-If the frame is in fullscreen mode, don't change its mode,
-just toggle the temporary frame parameter `maximized',
-so the frame will go to the right maximization state
-after disabling fullscreen mode.
+ "Toggle maximization state of selected frame.
+Maximize selected frame or un-maximize if it is already maximized.
+
+If the frame is in fullscreen state, don't change its state, but
+set the frame's `fullscreen-restore' parameter to `maximized', so
+the frame will be maximized after disabling fullscreen state.
Note that with some window managers you may have to set
`frame-resize-pixelwise' to non-nil in order to make a frame
-appear truly maximized.
+appear truly maximized. In addition, you may have to set
+`x-frame-normalize-before-maximize' in order to enable
+transitions from one fullscreen state to another.
See also `toggle-frame-fullscreen'."
(interactive)
- (if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (modify-frame-parameters
- nil
- `((maximized
- . ,(unless (eq (frame-parameter nil 'maximized) 'maximized)
- 'maximized))))
- (modify-frame-parameters
- nil
- `((fullscreen
- . ,(unless (eq (frame-parameter nil 'fullscreen) 'maximized)
- 'maximized))))))
+ (let ((fullscreen (frame-parameter nil 'fullscreen)))
+ (cond
+ ((memq fullscreen '(fullscreen fullboth))
+ (set-frame-parameter nil 'fullscreen-restore 'maximized))
+ ((eq fullscreen 'maximized)
+ (set-frame-parameter nil 'fullscreen nil))
+ (t
+ (set-frame-parameter nil 'fullscreen 'maximized)))))
(defun toggle-frame-fullscreen ()
- "Toggle fullscreen mode of the selected frame.
-Enable fullscreen mode of the selected frame or disable if it is
-already fullscreen. Ignore window manager screen decorations.
-When turning on fullscreen mode, remember the previous value of the
-maximization state in the temporary frame parameter `maximized'.
-Restore the maximization state when turning off fullscreen mode.
+ "Toggle fullscreen state of selected frame.
+Make selected frame fullscreen or restore its previous size if it
+is already fullscreen.
+
+Before making the frame fullscreen remember the current value of
+the frame's `fullscreen' parameter in the `fullscreen-restore'
+parameter of the frame. That value is used to restore the
+frame's fullscreen state when toggling fullscreen the next time.
Note that with some window managers you may have to set
`frame-resize-pixelwise' to non-nil in order to make a frame
-appear truly fullscreen.
+appear truly fullscreen. In addition, you may have to set
+`x-frame-normalize-before-maximize' in order to enable
+transitions from one fullscreen state to another.
See also `toggle-frame-maximized'."
(interactive)
- (modify-frame-parameters
- nil
- `((maximized
- . ,(unless (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (frame-parameter nil 'fullscreen)))
- (fullscreen
- . ,(if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (if (eq (frame-parameter nil 'maximized) 'maximized)
- 'maximized)
- 'fullscreen)))))
-
+ (let ((fullscreen (frame-parameter nil 'fullscreen)))
+ (if (memq fullscreen '(fullscreen fullboth))
+ (let ((fullscreen-restore (frame-parameter nil 'fullscreen-restore)))
+ (if (memq fullscreen-restore '(maximized fullheight fullwidth))
+ (set-frame-parameter nil 'fullscreen fullscreen-restore)
+ (set-frame-parameter nil 'fullscreen nil)))
+ (modify-frame-parameters
+ nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
\f
;;;; Key bindings