Merged from miles@gnu.org--gnu-2005 (patch 296-306)

[gnu-emacs] / lisp / frame.el

diff --git a/lisp/frame.el b/lisp/frame.el
index ad88102af65ebf786ee2a722145a84984c5cb036..25cc5aa38c830310c0a96bb0af8eb7c6540554db 100644 (file)
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1,6 +1,6 @@
 ;;; frame.el --- multi-frame management independent of window systems
 
 ;;; frame.el --- multi-frame management independent of window systems
 

-;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004
+;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004, 2005

 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF


@@ -153,7 +153,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
           ;; (set-window-dedicated-p window t)
           window))
        ;; If no window yet, make one in a new frame.
           ;; (set-window-dedicated-p window t)
           window))
        ;; If no window yet, make one in a new frame.

-       (let ((frame (make-frame (append args special-display-frame-alist))))
+       (let ((frame
+             (with-current-buffer buffer
+               (make-frame (append args special-display-frame-alist)))))

         (set-window-buffer (frame-selected-window frame) buffer)
         (set-window-dedicated-p (frame-selected-window frame) t)
         (frame-selected-window frame))))))
         (set-window-buffer (frame-selected-window frame) buffer)
         (set-window-dedicated-p (frame-selected-window frame) t)
         (frame-selected-window frame))))))


@@ -532,7 +534,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
 ;;;; Creation of additional frames, and other frame miscellanea
 
 (defun modify-all-frames-parameters (alist)
 ;;;; Creation of additional frames, and other frame miscellanea
 
 (defun modify-all-frames-parameters (alist)

-  "modify all current and future frames parameters according to ALIST.
+  "Modify all current and future frames' parameters according to ALIST.

 This changes `default-frame-alist' and possibly `initial-frame-alist'.
 See help of `modify-frame-parameters' for more information."
   (let (element)                       ;; temp
 This changes `default-frame-alist' and possibly `initial-frame-alist'.
 See help of `modify-frame-parameters' for more information."
   (let (element)                       ;; temp


@@ -577,12 +579,12 @@ is not considered (see `next-frame')."
   (select-frame-set-input-focus (selected-frame)))
 
 (defun make-frame-on-display (display &optional parameters)
   (select-frame-set-input-focus (selected-frame)))
 
 (defun make-frame-on-display (display &optional parameters)

-  "Make a frame on display DISPLAY.
+  "Make a frame on X display DISPLAY.

 The optional second argument PARAMETERS specifies additional frame parameters."
   (interactive "sMake frame on display: ")
   (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
       (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
 The optional second argument PARAMETERS specifies additional frame parameters."
   (interactive "sMake frame on display: ")
   (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
       (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))

-  (unless x-initialized
+  (when (and (boundp 'x-initialized) (not x-initialized))

     (setq x-display-name display)
     (x-initialize-window-system))
   (make-frame `((window-system . x) (display . ,display) . ,parameters)))
     (setq x-display-name display)
     (x-initialize-window-system))
   (make-frame `((window-system . x) (display . ,display) . ,parameters)))


@@ -616,7 +618,7 @@ The functions are run with one arg, the newly created frame.")
 
 ;; Alias, kept temporarily.
 (defalias 'new-frame 'make-frame)
 
 ;; Alias, kept temporarily.
 (defalias 'new-frame 'make-frame)

-(make-obsolete 'new-frame 'make-frame "21.4")
+(make-obsolete 'new-frame 'make-frame "22.1")

 
 (defun make-frame (&optional parameters)
   "Return a newly created frame displaying the current buffer.
 
 (defun make-frame (&optional parameters)
   "Return a newly created frame displaying the current buffer.


@@ -638,13 +640,28 @@ You cannot specify either `width' or `height', you must use neither or both.
  (window-system . nil) The frame should be displayed on a terminal device.
  (window-system . x)   The frame should be displayed in an X window.
 
  (window-system . nil) The frame should be displayed on a terminal device.
  (window-system . x)   The frame should be displayed in an X window.
 

+ (display-id . ID)      The frame should use the display identified by ID.
+

 Before the frame is created (via `frame-creation-function-alist'), functions on the
 hook `before-make-frame-hook' are run.  After the frame is created, functions
 Before the frame is created (via `frame-creation-function-alist'), functions on the
 hook `before-make-frame-hook' are run.  After the frame is created, functions

-on `after-make-frame-functions' are run with one arg, the newly created frame."
+on `after-make-frame-functions' are run with one arg, the newly created frame.
+
+This function itself does not make the new frame the selected frame.
+The previously selected frame remains selected.  However, the
+window system may select the new frame for its own reasons, for
+instance if the frame appears under the mouse pointer and your
+setup is for focus to follow the pointer."

   (interactive)
   (interactive)

-  (let* ((w (if (assq 'window-system parameters)
-               (cdr (assq 'window-system parameters))
-             window-system))
+  (let* ((w (cond
+            ((assq 'display-id parameters)
+             (let ((type (display-live-p (cdr (assq 'display-id parameters)))))
+               (cond
+                ((eq type t) nil)
+                ((eq type nil) (error "Display %s does not exist" (cdr (assq 'display-id parameters))))
+                (t type))))
+            ((assq 'window-system parameters)
+             (cdr (assq 'window-system parameters)))
+            (t window-system)))

         (frame-creation-function (cdr (assq w frame-creation-function-alist)))
         frame)
     (unless frame-creation-function
         (frame-creation-function (cdr (assq w frame-creation-function-alist)))
         frame)
     (unless frame-creation-function


@@ -674,20 +691,25 @@ on `after-make-frame-functions' are run with one arg, the newly created frame."
 
 (defun frames-on-display-list (&optional display)
   "Return a list of all frames on DISPLAY.
 
 (defun frames-on-display-list (&optional display)
   "Return a list of all frames on DISPLAY.

-DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN.
+
+DISPLAY should be a display identifier (an integer), but it may
+also be a name of a display, a string of the form HOST:SERVER.SCREEN.
+

 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
 If DISPLAY is omitted or nil, it defaults to the selected frame's display."

-  (let* ((display (or display (frame-parameter nil 'display)))
+  (let* ((display (or display (frame-display)))

         (func #'(lambda (frame)
         (func #'(lambda (frame)

-                  (equal (frame-parameter frame 'display) display))))
+                  (or (eq (frame-display frame) display)
+                      (equal (frame-parameter frame 'display) display)))))

     (filtered-frame-list func)))
 
 (defun framep-on-display (&optional display)
   "Return the type of frames on DISPLAY.
     (filtered-frame-list func)))
 
 (defun framep-on-display (&optional display)
   "Return the type of frames on DISPLAY.

-DISPLAY may be a display name or a frame.  If it is a frame, its type is
-returned.
+DISPLAY may be a display id, a display name or a frame.  If it is
+a frame, its type is returned.

 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
 All frames on a given display are of the same type."
 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
 All frames on a given display are of the same type."

-  (or (framep display)
+  (or (display-live-p display)
+      (framep display)

       (framep (car (frames-on-display-list display)))))
 
 (defun frame-remove-geometry-params (param-list)
       (framep (car (frames-on-display-list display)))))
 
 (defun frame-remove-geometry-params (param-list)


@@ -774,9 +796,9 @@ Calls `suspend-emacs' if invoked from the controlling terminal,
     (cond
      ((eq type 'x) (iconify-or-deiconify-frame))
      ((eq type t)
     (cond
      ((eq type 'x) (iconify-or-deiconify-frame))
      ((eq type t)

-      (if (frame-tty-name)
-         (suspend-tty)
-       (suspend-emacs)))
+      (if (display-controlling-tty-p)
+         (suspend-emacs)
+       (suspend-tty)))

      (t (suspend-emacs)))))
 
 
      (t (suspend-emacs)))))
 
 


@@ -842,6 +864,8 @@ where
   "Restore the frames to the state described by CONFIGURATION.
 Each frame listed in CONFIGURATION has its position, size, window
 configuration, and other parameters set as specified in CONFIGURATION.
   "Restore the frames to the state described by CONFIGURATION.
 Each frame listed in CONFIGURATION has its position, size, window
 configuration, and other parameters set as specified in CONFIGURATION.

+However, this function does not restore deleted frames.
+

 Ordinarily, this function deletes all existing frames not
 listed in CONFIGURATION.  But if optional second argument NODELETE
 is given and non-nil, the unwanted frames are iconified instead."
 Ordinarily, this function deletes all existing frames not
 listed in CONFIGURATION.  But if optional second argument NODELETE
 is given and non-nil, the unwanted frames are iconified instead."


@@ -1023,6 +1047,10 @@ bars (top, bottom, or nil)."
     (cons vert hor)))
 \f
 ;;;; Frame/display capabilities.
     (cons vert hor)))
 \f
 ;;;; Frame/display capabilities.

+(defun selected-display ()
+  "Return the display that is now selected."
+  (frame-display (selected-frame)))
+

 (defun display-mouse-p (&optional display)
   "Return non-nil if DISPLAY has a mouse available.
 DISPLAY can be a display name, a frame, or nil (meaning the selected
 (defun display-mouse-p (&optional display)
   "Return non-nil if DISPLAY has a mouse available.
 DISPLAY can be a display name, a frame, or nil (meaning the selected


@@ -1032,7 +1060,8 @@ frame's display)."
      ((eq frame-type 'pc)
       (msdos-mouse-p))
      ((eq system-type 'windows-nt)
      ((eq frame-type 'pc)
       (msdos-mouse-p))
      ((eq system-type 'windows-nt)

-      (> w32-num-mouse-buttons 0))
+      (with-no-warnings
+       (> w32-num-mouse-buttons 0)))

      ((memq frame-type '(x mac))
       t)    ;; We assume X and Mac *always* have a pointing device
      (t
      ((memq frame-type '(x mac))
       t)    ;; We assume X and Mac *always* have a pointing device
      (t


@@ -1085,7 +1114,8 @@ frame's display)."
      ((eq frame-type 'pc)
       ;; MS-DOG frames support selections when Emacs runs inside
       ;; the Windows' DOS Box.
      ((eq frame-type 'pc)
       ;; MS-DOG frames support selections when Emacs runs inside
       ;; the Windows' DOS Box.

-      (not (null dos-windows-version)))
+      (with-no-warnings
+       (not (null dos-windows-version))))

      ((memq frame-type '(x w32 mac))
       t)    ;; FIXME?
      (t
      ((memq frame-type '(x w32 mac))
       t)    ;; FIXME?
      (t


@@ -1236,7 +1266,7 @@ left untouched.  FRAME nil or omitted means use the selected frame."
 
 ;; miscellaneous obsolescence declarations
 (defvaralias 'delete-frame-hook 'delete-frame-functions)
 
 ;; miscellaneous obsolescence declarations
 (defvaralias 'delete-frame-hook 'delete-frame-functions)

-(make-obsolete-variable 'delete-frame-hook 'delete-frame-functions "21.4")
+(make-obsolete-variable 'delete-frame-hook 'delete-frame-functions "22.1")

 
 \f
 ;; Highlighting trailing whitespace.
 
 \f
 ;; Highlighting trailing whitespace.


@@ -1294,12 +1324,14 @@ The function `blink-cursor-start' is called when the timer fires.")
 
 (defvar blink-cursor-timer nil
   "Timer started from `blink-cursor-start'.
 
 (defvar blink-cursor-timer nil
   "Timer started from `blink-cursor-start'.

-This timer calls `blink-cursor' every `blink-cursor-interval' seconds.")
-
-(defvar blink-cursor-mode nil
-  "Non-nil means blinking cursor is active.")
-
-(defun blink-cursor-mode (arg)
+This timer calls `blink-cursor-timer-function' every
+`blink-cursor-interval' seconds.")
+
+;; We do not know the standard _evaluated_ value yet, because the standard
+;; expression uses values that are not yet set.  The correct evaluated
+;; standard value will be installed in startup.el using exactly the same
+;; expression as in the defcustom.
+(define-minor-mode blink-cursor-mode

   "Toggle blinking cursor mode.
 With a numeric argument, turn blinking cursor mode on iff ARG is positive.
 When blinking cursor mode is enabled, the cursor of the selected
   "Toggle blinking cursor mode.
 With a numeric argument, turn blinking cursor mode on iff ARG is positive.
 When blinking cursor mode is enabled, the cursor of the selected


@@ -1308,39 +1340,28 @@ window blinks.
 Note that this command is effective only when Emacs
 displays through a window system, because then Emacs does its own
 cursor display.  On a text-only terminal, this is not implemented."
 Note that this command is effective only when Emacs
 displays through a window system, because then Emacs does its own
 cursor display.  On a text-only terminal, this is not implemented."

-  (interactive "P")
-  (let ((on-p (if (null arg)
-                 (not blink-cursor-mode)
-               (> (prefix-numeric-value arg) 0))))
-    (if blink-cursor-idle-timer
-       (cancel-timer blink-cursor-idle-timer))
-    (if blink-cursor-timer
-       (cancel-timer blink-cursor-timer))
-    (setq blink-cursor-idle-timer nil
-         blink-cursor-timer nil
-         blink-cursor-mode nil)
-    (if on-p
-       (progn
-         ;; Hide the cursor.
-         ;(internal-show-cursor nil nil)
-         (setq blink-cursor-idle-timer
-               (run-with-idle-timer blink-cursor-delay
-                                    blink-cursor-delay
-                                    'blink-cursor-start))
-         (setq blink-cursor-mode t))
-      (internal-show-cursor nil t))))
-
-;; Note that this is really initialized from startup.el before
-;; the init-file is read.
-
-(defcustom blink-cursor nil
-  "*Non-nil means blinking cursor mode is active."
+  :init-value (not (or noninteractive
+                      (if (boundp 'no-blinking-cursor) no-blinking-cursor)
+                      (eq system-type 'ms-dos)
+                      (not (memq initial-window-system '(x w32)))))

   :group 'cursor
   :group 'cursor

-  :tag "Blinking cursor"
-  :type 'boolean
-  :set #'(lambda (symbol value)
-          (set-default symbol value)
-          (blink-cursor-mode (or value 0))))
+  :global t
+  (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
+  (if blink-cursor-timer (cancel-timer blink-cursor-timer))
+  (setq blink-cursor-idle-timer nil
+       blink-cursor-timer nil)
+  (if blink-cursor-mode
+      (progn
+       ;; Hide the cursor.
+       ;;(internal-show-cursor nil nil)
+       (setq blink-cursor-idle-timer
+             (run-with-idle-timer blink-cursor-delay
+                                  blink-cursor-delay
+                                  'blink-cursor-start)))
+    (internal-show-cursor nil t)))
+
+(defvaralias 'blink-cursor 'blink-cursor-mode)
+(make-obsolete-variable 'blink-cursor 'blink-cursor-mode "22.1")

 
 (defun blink-cursor-start ()
   "Timer function called from the timer `blink-cursor-idle-timer'.
 
 (defun blink-cursor-start ()
   "Timer function called from the timer `blink-cursor-idle-timer'.


@@ -1408,5 +1429,5 @@ Use Custom to set this variable to get the display updated."
 
 (provide 'frame)
 
 
 (provide 'frame)
 

-;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
+;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56

 ;;; frame.el ends here
 ;;; frame.el ends here