]> code.delx.au - gnu-emacs/blobdiff - lisp/frame.el
Un-revert changes mistakenly dropped by f9fabb2b
[gnu-emacs] / lisp / frame.el
index 94e581b1e24072c0528a521d8eba59d13d20671d..077687eeb6672273fdcee98ab5f1c3579f07eea8 100644 (file)
 ;;; 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),
@@ -217,6 +202,7 @@ This function runs the hook `focus-out-hook'."
   "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)
 
@@ -686,7 +672,8 @@ the new frame according to its own rules."
         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))
 
@@ -703,8 +690,8 @@ the new frame according to its own rules."
 
 ;;     (setq frame-size-history '(1000))
 
-    (setq frame
-          (funcall (gui-method frame-creation-function w) params))
+    (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)
@@ -1816,8 +1803,12 @@ command starts, by installing a pre-command hook."
 (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)