Merged from miles@gnu.org--gnu-2005 (patch 83-87, 449-468)
[bpt/emacs.git] / lisp / faces.el
index cad2e93..8211b0f 100644 (file)
@@ -932,7 +932,7 @@ an integer value."
   (let ((valid
          (case attribute
            (:family
-            (if window-system
+            (if (window-system frame)
                 (mapcar #'(lambda (x) (cons (car x) (car x)))
                         (x-font-family-list))
              ;; Only one font on TTYs.
@@ -941,7 +941,7 @@ an integer value."
             (mapcar #'(lambda (x) (cons (symbol-name x) x))
                     (internal-lisp-face-attribute-values attribute)))
            ((:underline :overline :strike-through :box)
-            (if window-system
+            (if (window-system frame)
                 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
                                (internal-lisp-face-attribute-values attribute))
                        (mapcar #'(lambda (c) (cons c c))
@@ -954,7 +954,7 @@ an integer value."
            ((:height)
             'integerp)
            (:stipple
-            (and (memq window-system '(x w32 mac))
+            (and (memq (window-system frame) '(x w32 mac))
                  (mapcar #'list
                          (apply #'nconc
                                 (mapcar (lambda (dir)
@@ -1072,7 +1072,7 @@ of a global face.  Value is the new attribute value."
               ;; explicitly in VALID, using color approximation code
               ;; in tty-colors.el.
               (when (and (memq attribute '(:foreground :background))
-                         (not (memq window-system '(x w32 mac)))
+                         (not (memq (window-system frame) '(x w32 mac)))
                          (not (member new-value
                                       '("unspecified"
                                         "unspecified-fg" "unspecified-bg"))))
@@ -1359,14 +1359,14 @@ If FRAME is nil, the current FRAME is used."
            req (car conjunct)
            options (cdr conjunct)
            match (cond ((eq req 'type)
-                        (or (memq window-system options)
+                        (or (memq (window-system frame) options)
                             ;; FIXME: This should be revisited to use
                             ;; display-graphic-p, provided that the
                             ;; color selection depends on the number
                             ;; of supported colors, and all defface's
                             ;; are changed to look at number of colors
                             ;; instead of (type graphic) etc.
-                            (and (null window-system)
+                            (and (null (window-system frame))
                                  (memq 'tty options))
                             (and (memq 'motif options)
                                  (featurep 'motif))
@@ -1579,35 +1579,38 @@ this won't have the expected effect."
                 (choice-item light)
                 (choice-item :tag "default" nil)))
 
-(defvar default-frame-background-mode nil
-  "Internal variable for the default brightness of the background.
-Emacs sets it automatically depending on the terminal type.
-The value `nil' means `dark'.  If Emacs runs in non-windowed
-mode from `xterm' or a similar terminal emulator, the value is
-`light'.  On rxvt terminals, the value depends on the environment
-variable COLORFGBG.")
 
 (defun frame-set-background-mode (frame)
   "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."
   (let* ((bg-resource
-         (and window-system
+         (and (window-system frame)
               (x-get-resource "backgroundMode" "BackgroundMode")))
         (bg-color (frame-parameter frame 'background-color))
+        (tty-type (frame-parameter frame 'tty-type))
         (bg-mode
          (cond (frame-background-mode)
                (bg-resource
                 (intern (downcase bg-resource)))
-               ((and (null window-system) (null bg-color))
-                ;; No way to determine this automatically (?).
-                (or default-frame-background-mode 'dark))
-               ;; Unspecified frame background color can only happen
-               ;; on tty's.
-               ((member bg-color '(unspecified "unspecified-bg"))
-                (or default-frame-background-mode 'dark))
+               ((and (null (window-system frame))
+                     ;; Unspecified frame background color can only
+                     ;; happen on tty's.
+                     (member bg-color '(nil unspecified "unspecified-bg")))
+                ;; There is no way to determine the background mode
+                ;; automatically, so we make a guess based on the
+                ;; terminal type.
+                (if (and tty-type
+                         (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+                                       tty-type))
+                    'light
+                  'dark))
                ((equal bg-color "unspecified-fg") ; inverted colors
-                (if (eq default-frame-background-mode 'light) 'dark 'light))
+                (if (and tty-type
+                         (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+                                       tty-type))
+                    'dark
+                  'light))
                ((>= (apply '+ (x-color-values bg-color frame))
                    ;; Just looking at the screen, colors whose
                    ;; values add up to .6 of the white total
@@ -1616,7 +1619,7 @@ according to the `background-mode' and `display-type' frame parameters."
                 'light)
                (t 'dark)))
         (display-type
-         (cond ((null window-system)
+         (cond ((null (window-system frame))
                 (if (tty-display-color-p frame) 'color 'mono))
                ((x-display-color-p frame)
                 'color)
@@ -1713,16 +1716,22 @@ Value is the new frame created."
   (setq parameters (x-handle-named-frame-geometry parameters))
   (let ((visibility-spec (assq 'visibility parameters))
        (frame-list (frame-list))
-       (frame (x-create-frame (cons '(visibility . nil) parameters)))
+       (frame (x-create-frame `((visibility . nil) . ,parameters)))
        success)
     (unwind-protect
        (progn
+         (x-setup-function-keys frame)
          (x-handle-reverse-video frame parameters)
          (frame-set-background-mode frame)
          (face-set-after-frame-default frame)
          (if (or (null frame-list) (null visibility-spec))
              (make-frame-visible frame)
            (modify-frame-parameters frame (list visibility-spec)))
+         ;; Arrange for the kill and yank functions to set and check the clipboard.
+         (modify-frame-parameters
+          frame '((interprogram-cut-function . x-select-text)))
+         (modify-frame-parameters
+          frame '((interprogram-paste-function . x-cut-buffer-or-selection-value)))
          (setq success t))
       (unless success
        (delete-frame frame)))
@@ -1751,7 +1760,7 @@ Initialize colors of certain faces from frame parameters."
        (when (not (equal face 'default))
          (face-spec-set face (face-user-default-spec face) frame)
          (internal-merge-in-global-face face frame)
-         (when (and (memq window-system '(x w32 mac))
+         (when (and (memq (window-system frame) '(x w32 mac))
                     (or (not (boundp 'inhibit-default-face-x-resources))
                         (not (eq face 'default))))
            (make-face-x-resource-internal face frame)))
@@ -1802,10 +1811,26 @@ created."
   (let ((frame (make-terminal-frame parameters))
        success)
     (unwind-protect
-       (progn
+       (with-selected-frame frame
          (tty-handle-reverse-video frame (frame-parameters frame))
          (frame-set-background-mode frame)
          (face-set-after-frame-default frame)
+         ;; Load library for our terminal type.
+         ;; User init file can set term-file-prefix to nil to prevent this.
+         (unless (null term-file-prefix)
+           (let ((term (cdr (assq 'tty-type parameters)))
+                 hyphend)
+             (while (and term
+                         (not (load (concat term-file-prefix term) t t)))
+               ;; Strip off last hyphen and what follows, then try again
+               (setq term
+                     (if (setq hyphend (string-match "[-_][^-_]+$" term))
+                         (substring term 0 hyphend)
+                       nil)))))
+         ;; Make sure the kill and yank functions do not touch the X clipboard.
+         (modify-frame-parameters frame '((interprogram-cut-function . nil)))
+         (modify-frame-parameters frame '((interprogram-paste-function . nil)))
+         (set-locale-environment nil frame)
          (setq success t))
       (unless success
        (delete-frame frame)))