X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1399490e2bb58e1e7212d7a8469e1286ced9423a..34dc21db6e57ebbad81a196002fcd3cc557f096e:/lisp/frame.el

diff --git a/lisp/frame.el b/lisp/frame.el
index 0f8fc523a1..59e4d67b76 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1,9 +1,9 @@
 ;;; frame.el --- multi-frame management independent of window systems
 
-;; Copyright (C) 1993-1994, 1996-1997, 2000-2013 Free Software
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2014 Free Software
 ;; Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: internal
 ;; Package: emacs
 
@@ -120,6 +120,23 @@ appended when the minibuffer frame is created."
 	(delete-frame frame t)
       ;; Gildea@x.org says it is ok to ask questions before terminating.
       (save-buffers-kill-emacs))))
+
+(defun handle-focus-in (_event)
+  "Handle a focus-in event.
+Focus-in events are usually bound to this function.
+Focus-in events occur when a frame has focus, but a switch-frame event
+is not generated.
+This function runs the hook `focus-in-hook'."
+  (interactive "e")
+  (run-hooks 'focus-in-hook))
+
+(defun handle-focus-out (_event)
+  "Handle a focus-out event.
+Focus-out events are usually bound to this function.
+Focus-out events occur when no frame has focus.
+This function runs the hook `focus-out-hook'."
+  (interactive "e")
+  (run-hooks 'focus-out-hook))
 
 ;;;; Arrangement of frames at startup
 
@@ -193,6 +210,8 @@ appended when the minibuffer frame is created."
 
 (declare-function tool-bar-mode "tool-bar" (&optional arg))
 
+(defalias 'tool-bar-lines-needed 'tool-bar-height)
+
 ;; 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.
@@ -317,6 +336,9 @@ there (in decreasing order of priority)."
 		   t))
 	  ;; Create the new frame.
 	  (let (parms new)
+	    ;; MS-Windows needs this to avoid inflooping below.
+	    (if (eq system-type 'windows-nt)
+		(sit-for 0 t))
 	    ;; If the frame isn't visible yet, wait till it is.
 	    ;; If the user has to position the window,
 	    ;; Emacs doesn't know its real position until
@@ -497,10 +519,7 @@ See help of `modify-frame-parameters' for more information."
   "Return some frame other than the current frame.
 Create one if necessary.  Note that the minibuffer frame, if separate,
 is not considered (see `next-frame')."
-  (let ((s (if (equal (next-frame (selected-frame)) (selected-frame))
-	       (make-frame)
-	     (next-frame (selected-frame)))))
-    s))
+  (if (equal (next-frame) (selected-frame)) (make-frame) (next-frame)))
 
 (defun next-multiframe-window ()
   "Select the next window, regardless of which frame it is on."
@@ -521,10 +540,14 @@ is not considered (see `next-frame')."
 (defun window-system-for-display (display)
   "Return the window system for DISPLAY.
 Return nil if we don't know how to interpret DISPLAY."
-  (cl-loop for descriptor in display-format-alist
-           for pattern = (car descriptor)
-           for system = (cdr descriptor)
-           when (string-match-p pattern display) return system))
+  ;; 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)))
+      nil
+    (cl-loop for descriptor in display-format-alist
+	     for pattern = (car descriptor)
+	     for system = (cdr descriptor)
+	     when (string-match-p pattern display) return system)))
 
 (defun make-frame-on-display (display &optional parameters)
   "Make a frame on display DISPLAY.
@@ -590,6 +613,8 @@ The functions are run with one arg, the newly created frame.")
   ;; FIXME: Shouldn't we add `font' here as well?
   "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
 
+(defvar x-display-name)
+
 (defun make-frame (&optional parameters)
   "Return a newly created frame displaying the current buffer.
 Optional argument PARAMETERS is an alist of frame parameters for
@@ -759,7 +784,7 @@ the user during startup."
 	(nreverse frame-initial-geometry-arguments))
   (cdr param-list))
 
-(declare-function x-focus-frame "xfns.c" (frame))
+(declare-function x-focus-frame "frame.c" (frame))
 
 (defun select-frame-set-input-focus (frame &optional norecord)
   "Select FRAME, raise it, and set input focus, if possible.
@@ -872,8 +897,11 @@ If there is no frame by that name, signal an error."
   "The brightness of the background.
 Set this to the symbol `dark' if your background color is dark,
 `light' if your background is light, or nil (automatic by default)
-if you want Emacs to examine the brightness for you.  Don't set this
-variable with `setq'; this won't have the expected effect."
+if you want Emacs to examine the brightness for you.
+
+If you change this without using customize, you should use
+`frame-set-background-mode' to update existing frames;
+e.g. (mapc 'frame-set-background-mode (frame-list))."
   :group 'faces
   :set #'(lambda (var value)
 	   (set-default var value)
@@ -886,6 +914,9 @@ variable with `setq'; this won't have the expected effect."
 (declare-function x-get-resource "frame.c"
 		  (attribute class &optional component subclass))
 
+;; Only used if window-system is not null.
+(declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
+
 (defvar inhibit-frame-set-background-mode nil)
 
 (defun frame-set-background-mode (frame &optional keep-face-specs)
@@ -1275,9 +1306,6 @@ keys and their meanings."
 
 
 ;;;; Frame/display capabilities.
-(defun selected-terminal ()
-  "Return the terminal that is now selected."
-  (frame-terminal (selected-frame)))
 
 (declare-function msdos-mouse-p "dosfns.c")
 
@@ -1299,17 +1327,17 @@ frame's display)."
 	       xterm-mouse-mode)
 	  ;; t-mouse is distributed with the GPM package.  It doesn't have
 	  ;; a toggle.
-	  (featurep 't-mouse))))))
+	  (featurep 't-mouse)
+	  ;; No way to check whether a w32 console has a mouse, assume
+	  ;; it always does.
+	  (boundp 'w32-use-full-screen-buffer))))))
 
 (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 ns)))
-   (display-mouse-p display)))
+  (display-mouse-p display))
 
 (defun display-graphic-p (&optional display)
   "Return non-nil if DISPLAY is a graphic display.
@@ -1353,7 +1381,8 @@ frame's display)."
 (declare-function x-display-screens "xfns.c" (&optional terminal))
 
 (defun display-screens (&optional display)
-  "Return the number of screens associated with DISPLAY."
+  "Return the number of screens associated with DISPLAY.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1365,7 +1394,12 @@ frame's display)."
 
 (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."
+For character terminals, each character counts as a single pixel.
+For graphical terminals, note that on \"multi-monitor\" setups this
+refers to the pixel height for all physical monitors associated
+with DISPLAY.  To get information for each physical monitor, use
+`display-monitor-attributes-list'.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1377,7 +1411,12 @@ For character terminals, each character counts as a single pixel."
 
 (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."
+For character terminals, each character counts as a single pixel.
+For graphical terminals, note that on \"multi-monitor\" setups this
+refers to the pixel width for all physical monitors associated
+with DISPLAY.  To get information for each physical monitor, use
+`display-monitor-attributes-list'.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1408,7 +1447,12 @@ displays not explicitly specified."
 (defun display-mm-height (&optional display)
   "Return the height of DISPLAY's screen in millimeters.
 System values can be overridden by `display-mm-dimensions-alist'.
-If the information is unavailable, value is nil."
+If the information is unavailable, value is nil.
+For graphical terminals, note that on \"multi-monitor\" setups this
+refers to the height in millimeters for all physical monitors
+associated with DISPLAY.  To get information for each physical
+monitor, use `display-monitor-attributes-list'.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (and (memq (framep-on-display display) '(x w32 ns))
        (or (cddr (assoc (or display (frame-parameter nil 'display))
 			display-mm-dimensions-alist))
@@ -1420,7 +1464,12 @@ If the information is unavailable, value is nil."
 (defun display-mm-width (&optional display)
   "Return the width of DISPLAY's screen in millimeters.
 System values can be overridden by `display-mm-dimensions-alist'.
-If the information is unavailable, value is nil."
+If the information is unavailable, value is nil.
+For graphical terminals, note that on \"multi-monitor\" setups this
+refers to the width in millimeters for all physical monitors
+associated with DISPLAY.  To get information for each physical
+monitor, use `display-monitor-attributes-list'.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (and (memq (framep-on-display display) '(x w32 ns))
        (or (cadr (assoc (or display (frame-parameter nil 'display))
 			display-mm-dimensions-alist))
@@ -1429,10 +1478,13 @@ If the information is unavailable, value is nil."
 
 (declare-function x-display-backing-store "xfns.c" (&optional terminal))
 
+;; In NS port, the return value may be `buffered', `retained', or
+;; `non-retained'.  See src/nsfns.m.
 (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."
+the question is inapplicable to a certain kind of display.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1443,7 +1495,8 @@ the question is inapplicable to a certain kind of display."
 (declare-function x-display-save-under "xfns.c" (&optional terminal))
 
 (defun display-save-under (&optional display)
-  "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
+  "Return non-nil if DISPLAY's screen supports the SaveUnder feature.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1454,7 +1507,8 @@ the question is inapplicable to a certain kind of display."
 (declare-function x-display-planes "xfns.c" (&optional terminal))
 
 (defun display-planes (&optional display)
-  "Return the number of planes supported by DISPLAY."
+  "Return the number of planes supported by DISPLAY.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1467,7 +1521,8 @@ the question is inapplicable to a certain kind of display."
 (declare-function x-display-color-cells "xfns.c" (&optional terminal))
 
 (defun display-color-cells (&optional display)
-  "Return the number of color cells supported by DISPLAY."
+  "Return the number of color cells supported by DISPLAY.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1482,7 +1537,8 @@ the question is inapplicable to a certain kind of display."
 (defun display-visual-class (&optional display)
   "Return 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'."
+`static-color', `pseudo-color', `true-color', or `direct-color'.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((memq frame-type '(x w32 ns))
@@ -1495,6 +1551,8 @@ The value is one of the symbols `static-gray', `gray-scale',
 
 (declare-function x-display-monitor-attributes-list "xfns.c"
 		  (&optional terminal))
+(declare-function w32-display-monitor-attributes-list "w32fns.c"
+		  (&optional display))
 (declare-function ns-display-monitor-attributes-list "nsfns.m"
 		  (&optional terminal))
 
@@ -1525,11 +1583,14 @@ is the closest to the frame if the frame does not intersect any
 physical monitors.  Every non-tip frame (including invisible one)
 in a graphical display is dominated by exactly one physical
 monitor at a time, though it can span multiple (or no) physical
-monitors."
+monitors.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
   (let ((frame-type (framep-on-display display)))
     (cond
      ((eq frame-type 'x)
       (x-display-monitor-attributes-list display))
+     ((eq frame-type 'w32)
+      (w32-display-monitor-attributes-list display))
      ((eq frame-type 'ns)
       (ns-display-monitor-attributes-list display))
      (t
@@ -1651,6 +1712,16 @@ left untouched.  FRAME nil or omitted means use the selected frame."
   :type 'number
   :group 'cursor)
 
+(defcustom blink-cursor-blinks 10
+  "How many times to blink before using a solid cursor on NS and X.
+Use 0 or negative value to blink forever."
+  :version "24.4"
+  :type 'integer
+  :group 'cursor)
+
+(defvar blink-cursor-blinks-done 1
+  "Number of blinks done since we started blinking on NS and X")
+
 (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.")
@@ -1668,6 +1739,7 @@ command starts, by installing a pre-command hook."
   (when (null blink-cursor-timer)
     ;; Set up the timer first, so that if this signals an error,
     ;; blink-cursor-end is not added to pre-command-hook.
+    (setq blink-cursor-blinks-done 1)
     (setq blink-cursor-timer
 	  (run-with-timer blink-cursor-interval blink-cursor-interval
 			  'blink-cursor-timer-function))
@@ -1676,7 +1748,14 @@ 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))))
+  (internal-show-cursor nil (not (internal-show-cursor-p)))
+  ;; 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)
+    (add-hook 'post-command-hook 'blink-cursor-check)))
+
 
 (defun blink-cursor-end ()
   "Stop cursor blinking.
@@ -1689,6 +1768,28 @@ itself as a pre-command hook."
     (cancel-timer blink-cursor-timer)
     (setq blink-cursor-timer nil)))
 
+(defun blink-cursor-suspend ()
+  "Suspend cursor blinking.
+This is called when no frame has focus and timers can be suspended.
+Timers are restarted by `blink-cursor-check', which is called when a
+frame receives focus."
+  (blink-cursor-end)
+  (when blink-cursor-idle-timer
+    (cancel-timer blink-cursor-idle-timer)
+    (setq blink-cursor-idle-timer nil)))
+
+(defun blink-cursor-check ()
+  "Check if cursor blinking shall be restarted.
+This is done when a frame gets focus.  Blink timers may be stopped by
+`blink-cursor-suspend'."
+  (when (and blink-cursor-mode
+	     (not blink-cursor-idle-timer))
+    (remove-hook 'post-command-hook 'blink-cursor-check)
+    (setq blink-cursor-idle-timer
+          (run-with-idle-timer blink-cursor-delay
+                               blink-cursor-delay
+                               'blink-cursor-start))))
+
 (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
 
 (define-minor-mode blink-cursor-mode
@@ -1709,13 +1810,15 @@ terminals, cursor blinking is controlled by the terminal."
   (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
   (setq blink-cursor-idle-timer nil)
   (blink-cursor-end)
+  (remove-hook 'focus-in-hook #'blink-cursor-check)
+  (remove-hook 'focus-out-hook #'blink-cursor-suspend)
   (when blink-cursor-mode
-    ;; Hide the cursor.
-    ;;(internal-show-cursor nil nil)
+    (add-hook 'focus-in-hook #'blink-cursor-check)
+    (add-hook 'focus-out-hook #'blink-cursor-suspend)
     (setq blink-cursor-idle-timer
           (run-with-idle-timer blink-cursor-delay
                                blink-cursor-delay
-                               'blink-cursor-start))))
+                               #'blink-cursor-start))))
 
 
 ;; Frame maximization/fullscreen