Fix menu-set-font interaction with Custom themes.
[bpt/emacs.git] / lisp / frame.el
index 06e2268..cf9c09b 100644 (file)
@@ -1,7 +1,6 @@
 ;;; frame.el --- multi-frame management independent of window systems
 
-;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -32,7 +31,7 @@
   (list (cons nil
              (if (fboundp 'tty-create-frame-with-faces)
                  'tty-create-frame-with-faces
-                (lambda (parameters)
+                (lambda (_parameters)
                   (error "Can't create multiple frames without a window system")))))
   "Alist of window-system dependent functions to call to create a new frame.
 The window system startup file should add its frame creation
@@ -40,8 +39,12 @@ 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'.")
 
 ;; The initial value given here used to ask for a minibuffer.
@@ -96,96 +99,6 @@ appended when the minibuffer frame is created."
                       (sexp :tag "Value")))
   :group 'frames)
 
-(defcustom pop-up-frame-alist nil
-  "Alist of parameters for automatically generated new frames.
-You can set this in your init file; for example,
-
-  (setq pop-up-frame-alist '((width . 80) (height . 20)))
-
-If non-nil, the value you specify here is used by the default
-`pop-up-frame-function' for the creation of new frames.
-
-Since `pop-up-frame-function' is used by `display-buffer' for
-making new frames, any value specified here by default affects
-the automatic generation of new frames via `display-buffer' and
-all functions based on it.  The behavior of `make-frame' is not
-affected by this variable."
-  :type '(repeat (cons :format "%v"
-                      (symbol :tag "Parameter")
-                      (sexp :tag "Value")))
-  :group 'frames)
-
-(defcustom pop-up-frame-function
-  (lambda () (make-frame pop-up-frame-alist))
-  "Function used by `display-buffer' for creating a new frame.
-This function is called with no arguments and should return a new
-frame.  The default value calls `make-frame' with the argument
-`pop-up-frame-alist'."
-  :type 'function
-  :group 'frames)
-
-(defcustom special-display-frame-alist
-  '((height . 14) (width . 80) (unsplittable . t))
-  "Alist of parameters for special frames.
-Special frames are used for buffers whose names are listed in
-`special-display-buffer-names' and for buffers whose names match
-one of the regular expressions in `special-display-regexps'.
-
-This variable can be set in your init file, like this:
-
-  (setq special-display-frame-alist '((width . 80) (height . 20)))
-
-These supersede the values given in `default-frame-alist'."
-  :type '(repeat (cons :format "%v"
-                        (symbol :tag "Parameter")
-                        (sexp :tag "Value")))
-  :group 'frames)
-
-(defun special-display-popup-frame (buffer &optional args)
-  "Display BUFFER and return the window chosen.
-If BUFFER is already displayed in a visible or iconified frame,
-raise that frame.  Otherwise, display BUFFER in a new frame.
-
-Optional argument ARGS is a list specifying additional
-information.
-
-If ARGS is an alist, use it as a list of frame parameters.  If
-these parameters contain \(same-window . t), display BUFFER in
-the selected window.  If they contain \(same-frame . t), display
-BUFFER in a window of the selected frame.
-
-If ARGS is a list whose car is a symbol, use (car ARGS) as a
-function to do the work.  Pass it BUFFER as first argument,
-and (cdr ARGS) as second."
-  (if (and args (symbolp (car args)))
-      (apply (car args) buffer (cdr args))
-    (let ((window (get-buffer-window buffer 0)))
-      (or
-       ;; If we have a window already, make it visible.
-       (when window
-        (let ((frame (window-frame window)))
-          (make-frame-visible frame)
-          (raise-frame frame)
-          window))
-       ;; Reuse the current window if the user requested it.
-       (when (cdr (assq 'same-window args))
-        (condition-case nil
-            (progn (switch-to-buffer buffer) (selected-window))
-          (error nil)))
-       ;; Stay on the same frame if requested.
-       (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
-        (let* ((pop-up-windows t)
-               pop-up-frames
-               special-display-buffer-names special-display-regexps)
-          (display-buffer buffer)))
-       ;; If no window yet, make one in a new frame.
-       (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))))))
-
 (defun handle-delete-frame (event)
   "Handle delete-frame events from the X server."
   (interactive "e")
@@ -296,22 +209,19 @@ there (in decreasing order of priority)."
               (null frame-initial-frame))
       ;; This case happens when we don't have a window system, and
       ;; also for MS-DOS frames.
-      (let ((parms (frame-parameters frame-initial-frame)))
+      (let ((parms (frame-parameters)))
        ;; Don't change the frame names.
        (setq parms (delq (assq 'name parms) parms))
        ;; Can't modify the minibuffer parameter, so don't try.
        (setq parms (delq (assq 'minibuffer parms) parms))
-       (modify-frame-parameters nil
-                                (if (null initial-window-system)
-                                    (append initial-frame-alist
-                                            window-system-frame-alist
-                                            default-frame-alist
-                                            parms
-                                            nil)
-                                  ;; initial-frame-alist and
-                                  ;; default-frame-alist were already
-                                  ;; applied in pc-win.el.
-                                  parms))
+       (modify-frame-parameters
+        nil
+        (if initial-window-system
+            parms
+          ;; initial-frame-alist and default-frame-alist were already
+          ;; applied in pc-win.el.
+          (append initial-frame-alist window-system-frame-alist
+                  default-frame-alist parms nil)))
        (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el
            (let ((newparms (frame-parameters))
                  (frame (selected-frame)))
@@ -490,7 +400,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
@@ -512,25 +422,28 @@ there (in decreasing order of priority)."
          ;; it is undesirable to specify the parm again
           ;; once the user has seen the frame and been able to alter it
          ;; manually.
-         (while tail
-           (let (newval oldval)
-             (setq oldval (assq (car (car tail))
-                                frame-initial-frame-alist))
-             (setq newval (cdr (assq (car (car tail)) allparms)))
+         (let (newval oldval)
+           (dolist (entry tail)
+             (setq oldval (assq (car entry) frame-initial-frame-alist))
+             (setq newval (cdr (assq (car entry) allparms)))
              (or (and oldval (eq (cdr oldval) newval))
                  (setq newparms
-                       (cons (cons (car (car tail)) newval) newparms))))
-           (setq tail (cdr tail)))
+                       (cons (cons (car entry) newval) newparms)))))
          (setq newparms (nreverse newparms))
-         (modify-frame-parameters frame-initial-frame
-                                  newparms)
-         ;; If we changed the background color,
-         ;; we need to update the background-mode parameter
-         ;; and maybe some faces too.
-         (when (assq 'background-color newparms)
-           (unless (assq 'background-mode newparms)
-             (frame-set-background-mode frame-initial-frame))
-           (face-set-after-frame-default frame-initial-frame)))))
+
+         (let ((new-bg (assq 'background-color newparms)))
+           ;; If the `background-color' parameter is changed, apply
+           ;; it first, then make sure that the `background-mode'
+           ;; parameter and other faces are updated, before applying
+           ;; the other parameters.
+           (when new-bg
+             (modify-frame-parameters frame-initial-frame
+                                      (list new-bg))
+             (unless (assq 'background-mode newparms)
+               (frame-set-background-mode frame-initial-frame))
+             (face-set-after-frame-default frame-initial-frame)
+             (setq newparms (delq new-bg newparms)))
+           (modify-frame-parameters frame-initial-frame newparms)))))
 
     ;; Restore the original buffer.
     (set-buffer old-buffer)
@@ -838,12 +751,15 @@ the user during startup."
 
 (declare-function x-focus-frame "xfns.c" (frame))
 
-(defun select-frame-set-input-focus (frame)
+(defun select-frame-set-input-focus (frame &optional norecord)
   "Select FRAME, raise it, and set input focus, if possible.
 If `mouse-autoselect-window' is non-nil, also move mouse pointer
 to FRAME's selected window.  Otherwise, if `focus-follows-mouse'
-is non-nil, move mouse cursor to FRAME."
-  (select-frame frame)
+is non-nil, move mouse cursor to FRAME.
+
+Optional argument NORECORD means to neither change the order of
+recently selected windows nor the buffer list."
+  (select-frame frame norecord)
   (raise-frame frame)
   ;; Ensure, if possible, that FRAME gets input focus.
   (when (memq (window-system frame) '(x w32 ns))
@@ -938,6 +854,116 @@ If there is no frame by that name, signal an error."
     (if frame
        (select-frame-set-input-focus frame)
       (error "There is no frame named `%s'" name))))
+
+\f
+;;;; Background mode.
+
+(defcustom frame-background-mode nil
+  "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."
+  :group 'faces
+  :set #'(lambda (var value)
+          (set-default var value)
+          (mapc 'frame-set-background-mode (frame-list)))
+  :initialize 'custom-initialize-changed
+  :type '(choice (const dark)
+                (const light)
+                (const :tag "automatic" nil)))
+
+(declare-function x-get-resource "frame.c"
+                 (attribute class &optional component subclass))
+
+(defvar inhibit-frame-set-background-mode nil)
+
+(defun frame-set-background-mode (frame &optional keep-face-specs)
+  "Set up display-dependent faces on FRAME.
+Display-dependent faces are those which have different definitions
+according to the `background-mode' and `display-type' frame parameters.
+
+If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
+face specs for the new background mode."
+  (unless inhibit-frame-set-background-mode
+    (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
+          (bg-color (frame-parameter frame 'background-color))
+          (tty-type (tty-type frame))
+          (default-bg-mode
+            (if (or (window-system frame)
+                    (and tty-type
+                         (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
+                                       tty-type)))
+                'light
+              'dark))
+          (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
+          (bg-mode
+           (cond (frame-default-bg-mode)
+                 ((equal bg-color "unspecified-fg") ; inverted colors
+                  non-default-bg-mode)
+                 ((not (color-values bg-color frame))
+                  default-bg-mode)
+                 ((>= (apply '+ (color-values bg-color frame))
+                      ;; Just looking at the screen, colors whose
+                      ;; values add up to .6 of the white total
+                      ;; still look dark to me.
+                      (* (apply '+ (color-values "white" frame)) .6))
+                  'light)
+                 (t 'dark)))
+          (display-type
+           (cond ((null (window-system frame))
+                  (if (tty-display-color-p frame) 'color 'mono))
+                 ((display-color-p frame)
+                  'color)
+                 ((x-display-grayscale-p frame)
+                  'grayscale)
+                 (t 'mono)))
+          (old-bg-mode
+           (frame-parameter frame 'background-mode))
+          (old-display-type
+           (frame-parameter frame 'display-type)))
+
+      (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
+       (let ((locally-modified-faces nil)
+             ;; Prevent face-spec-recalc from calling this function
+             ;; again, resulting in a loop (bug#911).
+             (inhibit-frame-set-background-mode t)
+             (params (list (cons 'background-mode bg-mode)
+                           (cons 'display-type display-type))))
+         (if keep-face-specs
+             (modify-frame-parameters frame params)
+           ;; If we are recomputing face specs, first collect a list
+           ;; of faces that don't match their face-specs.  These are
+           ;; the faces modified on FRAME, and we avoid changing them
+           ;; below.  Use a negative list to avoid consing (we assume
+           ;; most faces are unmodified).
+           (dolist (face (face-list))
+             (and (not (get face 'face-override-spec))
+                  (not (face-spec-match-p face
+                                          (face-user-default-spec face)
+                                          (selected-frame)))
+                  (push face locally-modified-faces)))
+           ;; Now change to the new frame parameters
+           (modify-frame-parameters frame params)
+           ;; For all unmodified named faces, choose face specs
+           ;; matching the new frame parameters.
+           (dolist (face (face-list))
+             (unless (memq face locally-modified-faces)
+               (face-spec-recalc face frame)))))))))
+
+(defun frame-terminal-default-bg-mode (frame)
+  "Return the default background mode of FRAME.
+This checks the `frame-background-mode' variable, the X resource
+named \"backgroundMode\" (if FRAME is an X frame), and finally
+the `background-mode' terminal parameter."
+  (or frame-background-mode
+      (let ((bg-resource
+            (and (window-system frame)
+                 (x-get-resource "backgroundMode" "BackgroundMode"))))
+       (if bg-resource
+           (intern (downcase bg-resource))))
+      (terminal-parameter frame 'background-mode)))
+
 \f
 ;;;; Frame configurations
 
@@ -1026,15 +1052,22 @@ 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-name &optional keep-size all-frames)
+  "Set the default font to FONT-NAME.
+When called interactively, prompt for the name of a font, and use
+that font on the selected frame.
+
+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 ALL-FRAMES is nil, apply the font to the selected frame only.
+If ALL-FRAMES is non-nil, apply the font to all frames; in
+addition, 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: "
@@ -1043,19 +1076,52 @@ 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 (stringp font-name)
+    (let* ((this-frame (selected-frame))
+          (frames (if all-frames (frame-list) (list this-frame)))
+          height width)
+      (dolist (f frames)
+       (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-name)
+         (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 all-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.
@@ -1086,7 +1152,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))))
@@ -1111,23 +1181,41 @@ 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.
-With ARG, turn auto-raise mode on if and only if ARG is positive.
-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."
+  "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.
+
+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)))
 
 (define-minor-mode auto-lower-mode
   "Toggle whether or not the selected frame should auto-lower.
-With ARG, turn auto-lower mode on if and only if ARG is positive.
-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."
+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.
+
+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)
@@ -1271,7 +1359,7 @@ Each element of the alist has the form (display . (width . height)),
 e.g. (\":0.0\" . (287 . 215)).
 
 If `display' equals t, it specifies dimensions for all graphical
-displays not explicitely specified."
+displays not explicitly specified."
   :version "22.1"
   :type '(alist :key-type (choice (string :tag "Display name")
                                  (const :tag "Default" t))
@@ -1431,11 +1519,11 @@ Examples (measures in pixels) -
 
 In the 3rd, 4th, and 6th examples, the returned value is relative to
 the opposite frame edge from the edge indicated in the input spec."
-  (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec))))
+  (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
 \f
 
 (defun delete-other-frames (&optional frame)
-  "Delete all frames except FRAME.
+  "Delete all frames on the current terminal, except FRAME.
 If FRAME uses another frame's minibuffer, the minibuffer frame is
 left untouched.  FRAME nil or omitted means use the selected frame."
   (interactive)
@@ -1534,18 +1622,17 @@ itself as a pre-command hook."
     (setq blink-cursor-timer nil)))
 
 (define-minor-mode blink-cursor-mode
-  "Toggle blinking cursor mode.
-With a numeric argument, turn blinking cursor mode on if ARG is positive,
-otherwise turn it off.  When blinking cursor mode is enabled, the
-cursor of the selected 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."
+  "Toggle cursor blinking (Blink Cursor mode).
+With a prefix argument ARG, enable Blink Cursor mode if ARG is
+positive, and disable it otherwise.  If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+This command is effective only on graphical frames.  On text-only
+terminals, cursor blinking is controlled by the terminal."
   :init-value (not (or noninteractive
                       no-blinking-cursor
                       (eq system-type 'ms-dos)
-                      (not (memq window-system '(x w32)))))
+                      (not (memq window-system '(x w32 ns)))))
   :initialize 'custom-initialize-delay
   :group 'cursor
   :global t