Merge from trunk
[bpt/emacs.git] / lisp / frame.el
index f63179d..b7b61bc 100644 (file)
@@ -1,6 +1,6 @@
 ;;; frame.el --- multi-frame management independent of window systems
 
-;; Copyright (C) 1993-1994, 1996-1997, 2000-2011
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -25,7 +25,7 @@
 ;;; Commentary:
 
 ;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (defvar frame-creation-function-alist
   (list (cons nil
@@ -39,10 +39,20 @@ function to this list, which should take an alist of parameters
 as its argument.")
 
 (defvar window-system-default-frame-alist nil
-  "Alist of window-system dependent default frame parameters.
-Parameters specified here supersede the values given in
+  "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')
+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
 `default-frame-alist'.")
 
+(defvar display-format-alist nil
+  "Alist of patterns to decode display names.
+The car of each entry is a regular expression matching a display
+name string.  The cdr is a symbol giving the window-system that
+handles the corresponding kind of display.")
+
 ;; The initial value given here used to ask for a minibuffer.
 ;; But that's not necessary, because the default is to have one.
 ;; By not specifying it here, we let an X resource specify it.
@@ -299,7 +309,7 @@ there (in decreasing order of priority)."
       ;; existing frame.  We need to explicitly include
       ;; default-frame-alist in the parameters of the screen we
       ;; create here, so that its new value, gleaned from the user's
-      ;; .emacs file, will be applied to the existing screen.
+      ;; init file, will be applied to the existing screen.
       (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
                            (assq 'minibuffer window-system-frame-alist)
                            (assq 'minibuffer default-frame-alist)
@@ -396,7 +406,7 @@ there (in decreasing order of priority)."
            ;; Finally, get rid of the old frame.
            (delete-frame frame-initial-frame t))
 
-       ;; Otherwise, we don't need all that rigamarole; just apply
+       ;; Otherwise, we don't need all that rigmarole; just apply
        ;; the new parameters.
        (let (newparms allparms tail)
          (setq allparms (append initial-frame-alist
@@ -508,31 +518,19 @@ is not considered (see `next-frame')."
                                  0))
   (select-frame-set-input-focus (selected-frame)))
 
-(declare-function x-initialize-window-system "term/x-win" ())
-(declare-function ns-initialize-window-system "term/ns-win" ())
-(defvar x-display-name)                 ; term/x-win
+(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))
 
 (defun make-frame-on-display (display &optional parameters)
   "Make a frame on display DISPLAY.
 The optional argument PARAMETERS specifies additional frame parameters."
   (interactive "sMake frame on display: ")
-  (cond ((featurep 'ns)
-        (when (and (boundp 'ns-initialized) (not ns-initialized))
-          (setq x-display-name display)
-          (ns-initialize-window-system))
-        (make-frame `((window-system . ns)
-                      (display . ,display) . ,parameters)))
-       ((eq system-type 'windows-nt)
-        ;; On Windows, ignore DISPLAY.
-        (make-frame parameters))
-       (t
-        (unless (string-match-p "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
-          (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
-        (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)))))
+  (make-frame (cons (cons 'display display) parameters)))
 
 (declare-function x-close-connection "xfns.c" (terminal))
 
@@ -614,6 +612,8 @@ 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.
 
+ (display . \":0\")     The frame should appear on display :0.
+
  (terminal . TERMINAL)  The frame should use the terminal object TERMINAL.
 
 In addition, any parameter specified in `default-frame-alist',
@@ -624,11 +624,15 @@ this function runs the hook `before-make-frame-hook'.  After
 creating the frame, it runs the hook `after-make-frame-functions'
 with one arg, the newly created frame.
 
+If a display parameter is supplied and a window-system is not,
+guess the window-system from the display.
+
 On graphical displays, this function does not itself make the new
 frame the selected frame.  However, the window system may select
 the new frame according to its own rules."
   (interactive)
-  (let* ((w (cond
+  (let* ((display (cdr (assq 'display parameters)))
+         (w (cond
             ((assq 'terminal parameters)
              (let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
                (cond
@@ -638,6 +642,10 @@ the new frame according to its own rules."
                 (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)))
         (oldframe (selected-frame))
@@ -645,6 +653,11 @@ the new frame according to its own rules."
         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)))
+      (put w 'window-system-initialized t))
+
     ;; Add parameters from `window-system-default-frame-alist'.
     (dolist (p (cdr (assq w window-system-default-frame-alist)))
       (unless (assq (car p) params)
@@ -1048,15 +1061,25 @@ If FRAME is omitted, describe the currently selected frame."
                   (pattern &optional face frame maximum width))
 
 (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1")
-(defun set-frame-font (font-name &optional keep-size)
-  "Set the font of the selected frame to FONT-NAME.
-When called interactively, prompt for the name of the font to use.
-To get the frame's current default font, use `frame-parameters'.
-
-The default behavior is to keep the numbers of lines and columns in
-the frame, thus may change its pixel size.  If optional KEEP-SIZE is
-non-nil (interactively, prefix argument) the current frame size (in
-pixels) is kept by adjusting the numbers of the lines and columns."
+
+(defun set-frame-font (font &optional keep-size frames)
+  "Set the default font to FONT.
+When called interactively, prompt for the name of a font, and use
+that font on the selected frame.  When called from Lisp, FONT
+should be a font name (a string), a font object, font entity, or
+font spec.
+
+If KEEP-SIZE is nil, keep the number of frame lines and columns
+fixed.  If KEEP-SIZE is non-nil (or with a prefix argument), try
+to keep the current frame size fixed (in pixels) by adjusting the
+number of lines and columns.
+
+If FRAMES is nil, apply the font to the selected frame only.
+If FRAMES is non-nil, it should be a list of frames to act upon,
+or t meaning all graphical frames.  Also, if FRAME is non-nil,
+alter the user's Customization settings as though the
+font-related attributes of the `default' face had been \"set in
+this session\", so that the font is applied to future frames."
   (interactive
    (let* ((completion-ignore-case t)
          (font (completing-read "Font name: "
@@ -1065,19 +1088,57 @@ pixels) is kept by adjusting the numbers of the lines and columns."
                                 (x-list-fonts "*" nil (selected-frame))
                                  nil nil nil nil
                                  (frame-parameter nil 'font))))
-     (list font current-prefix-arg)))
-  (let (fht fwd)
-    (if keep-size
-       (setq fht (* (frame-parameter nil 'height) (frame-char-height))
-             fwd (* (frame-parameter nil 'width)  (frame-char-width))))
-    (modify-frame-parameters (selected-frame)
-                            (list (cons 'font font-name)))
-    (if keep-size
-       (modify-frame-parameters
-        (selected-frame)
-        (list (cons 'height (round fht (frame-char-height)))
-              (cons 'width (round fwd (frame-char-width)))))))
-  (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
+     (list font current-prefix-arg nil)))
+  (when (or (stringp font) (fontp font))
+    (let* ((this-frame (selected-frame))
+          ;; FRAMES nil means affect the selected frame.
+          (frame-list (cond ((null frames)
+                             (list this-frame))
+                            ((eq frames t)
+                             (frame-list))
+                            (t frames)))
+          height width)
+      (dolist (f frame-list)
+       (when (display-multi-font-p f)
+         (if keep-size
+             (setq height (* (frame-parameter f 'height)
+                             (frame-char-height f))
+                   width  (* (frame-parameter f 'width)
+                             (frame-char-width f))))
+         ;; When set-face-attribute is called for :font, Emacs
+         ;; guesses the best font according to other face attributes
+         ;; (:width, :weight, etc.) so reset them too (Bug#2476).
+         (set-face-attribute 'default f
+                             :width 'normal :weight 'normal
+                             :slant 'normal :font font)
+         (if keep-size
+             (modify-frame-parameters
+              f
+              (list (cons 'height (round height (frame-char-height f)))
+                    (cons 'width  (round width  (frame-char-width f))))))))
+      (when frames
+       ;; Alter the user's Custom setting of the `default' face, but
+       ;; only for font-related attributes.
+       (let ((specs (cadr (assq 'user (get 'default 'theme-face))))
+             (attrs '(:family :foundry :slant :weight :height :width))
+             (new-specs nil))
+         (if (null specs) (setq specs '((t nil))))
+         (dolist (spec specs)
+           ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
+           (let ((display (nth 0 spec))
+                 (plist   (copy-tree (nth 1 spec))))
+             ;; Alter only DISPLAY conditions matching this frame.
+             (when (or (memq display '(t default))
+                       (face-spec-set-match-display display this-frame))
+               (dolist (attr attrs)
+                 (setq plist (plist-put plist attr
+                                        (face-attribute 'default attr)))))
+             (push (list display plist) new-specs)))
+         (setq new-specs (nreverse new-specs))
+         (put 'default 'customized-face new-specs)
+         (custom-push-theme 'theme-face 'default 'user 'set new-specs)
+         (put 'default 'face-modified nil))))
+    (run-hooks 'after-setting-font-hook 'after-setting-font-hooks)))
 
 (defun set-frame-parameter (frame parameter value)
   "Set frame parameter PARAMETER to VALUE on FRAME.
@@ -1108,7 +1169,11 @@ To get the frame's current foreground color, use `frame-parameters'."
 (defun set-cursor-color (color-name)
   "Set the text cursor color of the selected frame to COLOR-NAME.
 When called interactively, prompt for the name of the color to use.
-To get the frame's current cursor color, use `frame-parameters'."
+This works by setting the `cursor-color' frame parameter on the
+selected frame.
+
+You can also set the text cursor color, for all frames, by
+customizing the `cursor' face."
   (interactive (list (read-color "Cursor color: ")))
   (modify-frame-parameters (selected-frame)
                           (list (cons 'cursor-color color-name))))
@@ -1133,15 +1198,21 @@ To get the frame's current border color, use `frame-parameters'."
                           (list (cons 'border-color color-name))))
 
 (define-minor-mode auto-raise-mode
-  "Toggle whether or not the selected frame should auto-raise.
+  "Toggle whether or not selected frames should auto-raise.
 With a prefix argument ARG, enable Auto Raise mode if ARG is
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
-Note that this controls Emacs's own auto-raise feature.
-Some window managers allow you to enable auto-raise for certain windows.
-You can use that for Emacs windows if you wish, but if you do,
-that is beyond the control of Emacs and this command has no effect on it."
+Auto Raise mode does nothing under most window managers, which
+switch focus on mouse clicks.  It only has an effect if your
+window manager switches focus on mouse movement (in which case
+you should also change `focus-follows-mouse' to t).  Then,
+enabling Auto Raise mode causes any graphical Emacs frame which
+acquires focus to be automatically raised.
+
+Note that this minor mode controls Emacs's own auto-raise
+feature.  Window managers that switch focus on mouse movement
+often have their own auto-raise feature."
   :variable (frame-parameter nil 'auto-raise)
   (if (frame-parameter nil 'auto-raise)
       (raise-frame)))
@@ -1152,17 +1223,23 @@ With a prefix argument ARG, enable Auto Lower mode if ARG is
 positive, and disable it otherwise.  If called from Lisp, enable
 the mode if ARG is omitted or nil.
 
-Note that this controls Emacs's own auto-lower feature.
-Some window managers allow you to enable auto-lower for certain windows.
-You can use that for Emacs windows if you wish, but if you do,
-that is beyond the control of Emacs and this command has no effect on it."
+Auto Lower mode does nothing under most window managers, which
+switch focus on mouse clicks.  It only has an effect if your
+window manager switches focus on mouse movement (in which case
+you should also change `focus-follows-mouse' to t).  Then,
+enabling Auto Lower Mode causes any graphical Emacs frame which
+loses focus to be automatically lowered.
+
+Note that this minor mode controls Emacs's own auto-lower
+feature.  Window managers that switch focus on mouse movement
+often have their own features for raising or lowering frames."
   :variable (frame-parameter nil 'auto-lower))
 
 (defun set-frame-name (name)
   "Set the name of the selected frame to NAME.
 When called interactively, prompt for the name of the frame.
-The frame name is displayed on the modeline if the terminal displays only
-one frame, otherwise the name is displayed on the frame's caption bar."
+On text terminals, the frame name is displayed on the mode line.
+On graphical displays, it is displayed on the frame's title bar."
   (interactive "sFrame name: ")
   (modify-frame-parameters (selected-frame)
                           (list (cons 'name name))))
@@ -1194,7 +1271,7 @@ frame's display)."
     (cond
      ((eq frame-type 'pc)
       (msdos-mouse-p))
-     ((eq system-type 'windows-nt)
+     ((eq frame-type 'w32)
       (with-no-warnings
        (> w32-num-mouse-buttons 0)))
      ((memq frame-type '(x ns))
@@ -1491,21 +1568,6 @@ left untouched.  FRAME nil or omitted means use the selected frame."
     'delete-frame-functions "22.1")
 
 \f
-;; Highlighting trailing whitespace.
-
-(make-variable-buffer-local 'show-trailing-whitespace)
-
-\f
-;; Scrolling
-
-(defgroup scrolling nil
-  "Scrolling windows."
-  :version "21.1"
-  :group 'frames)
-
-(defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
-
-\f
 ;; Blinking cursor
 
 (defgroup cursor nil
@@ -1561,6 +1623,8 @@ itself as a pre-command hook."
     (cancel-timer blink-cursor-timer)
     (setq blink-cursor-timer nil)))
 
+(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
+
 (define-minor-mode blink-cursor-mode
   "Toggle cursor blinking (Blink Cursor mode).
 With a prefix argument ARG, enable Blink Cursor mode if ARG is
@@ -1587,8 +1651,6 @@ terminals, cursor blinking is controlled by the terminal."
                                blink-cursor-delay
                                'blink-cursor-start))))
 
-(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
-
 \f
 ;;;; Key bindings
 
@@ -1597,6 +1659,19 @@ terminals, cursor blinking is controlled by the terminal."
 (define-key ctl-x-5-map "0" 'delete-frame)
 (define-key ctl-x-5-map "o" 'other-frame)
 
+\f
+;; Misc.
+
+;; Only marked as obsolete in 24.3.
+(define-obsolete-variable-alias 'automatic-hscrolling
+  'auto-hscroll-mode "22.1")
+
+(make-variable-buffer-local 'show-trailing-whitespace)
+
+;; Defined in dispnew.c.
+(make-obsolete-variable
+ 'window-system-version "it does not give useful information." "24.3")
+
 (provide 'frame)
 
 ;;; frame.el ends here