Use set-face-underline rather than the alias set-face-underline-p

[gnu-emacs] / lisp / frame.el

diff --git a/lisp/frame.el b/lisp/frame.el
index f63179de1f12b589c231b06fe4787b0cae3b0d93..7a54efc23e7c5fffba49fb2ac535ad0322e218b6 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-2011
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2012

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


@@ -25,7 +25,7 @@
 ;;; Commentary:
 
 ;;; Code:
 ;;; Commentary:
 
 ;;; Code:

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))

 
 (defvar frame-creation-function-alist
   (list (cons nil
 
 (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
 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'.")
 
 `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.
 ;; 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
       ;; 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)
       (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))
 
            ;; 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
        ;; 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)))
 
                                  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: ")
 
 (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))
 
 
 (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.
 
  (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',
  (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.
 
 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)
 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
             ((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)))
                 (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))
             (t window-system)))
         (frame-creation-function (cdr (assq w frame-creation-function-alist)))
         (oldframe (selected-frame))


@@ -645,6 +653,13 @@ 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))
         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)
+      (unless x-display-name
+        (setq x-display-name display))
+      (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)
     ;; 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 +1063,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")
                   (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: "
   (interactive
    (let* ((completion-ignore-case t)
          (font (completing-read "Font name: "


@@ -1065,19 +1090,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))))
                                 (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.
 
 (defun set-frame-parameter (frame parameter value)
   "Set frame parameter PARAMETER to VALUE on FRAME.


@@ -1108,7 +1171,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.
 (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))))
   (interactive (list (read-color "Cursor color: ")))
   (modify-frame-parameters (selected-frame)
                           (list (cons 'cursor-color color-name))))


@@ -1133,15 +1200,21 @@ To get the frame's current border color, use `frame-parameters'."
                           (list (cons 'border-color color-name))))
 
 (define-minor-mode auto-raise-mode
                           (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.
 
 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)))
   :variable (frame-parameter nil 'auto-raise)
   (if (frame-parameter nil 'auto-raise)
       (raise-frame)))


@@ -1152,17 +1225,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.
 
 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.
   :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))))
   (interactive "sFrame name: ")
   (modify-frame-parameters (selected-frame)
                           (list (cons 'name name))))


@@ -1194,7 +1273,7 @@ frame's display)."
     (cond
      ((eq frame-type 'pc)
       (msdos-mouse-p))
     (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))
       (with-no-warnings
        (> w32-num-mouse-buttons 0)))
      ((memq frame-type '(x ns))


@@ -1490,21 +1569,6 @@ left untouched.  FRAME nil or omitted means use the selected frame."
 (define-obsolete-variable-alias 'delete-frame-hook
     'delete-frame-functions "22.1")
 
 (define-obsolete-variable-alias 'delete-frame-hook
     '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
 
 \f
 ;; Blinking cursor
 


@@ -1561,6 +1625,8 @@ itself as a pre-command hook."
     (cancel-timer blink-cursor-timer)
     (setq blink-cursor-timer nil)))
 
     (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
 (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 +1653,6 @@ terminals, cursor blinking is controlled by the terminal."
                                blink-cursor-delay
                                'blink-cursor-start))))
 
                                blink-cursor-delay
                                'blink-cursor-start))))
 

-(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
-

 \f
 ;;;; Key bindings
 
 \f
 ;;;; Key bindings
 


@@ -1597,6 +1661,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)
 
 (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
 (provide 'frame)
 
 ;;; frame.el ends here