"*A list specifying how face font selection chooses fonts.
Each of the four symbols `:width', `:height', `:weight', and `:slant'
must appear once in the list, and the list must not contain any other
-elements. Font selection tries to find a best matching font for
-those face attributes first that appear first in the list. For
+elements. Font selection first tries to find a best matching font
+for those face attributes that appear before in the list. For
example, if `:slant' appears before `:height', font selection first
tries to find a font with a suitable slant, even if this results in
a font height that isn't optimal."
(defun face-id (face &optional frame)
"Return the internal ID of face with name FACE.
+If FACE is a face-alias, return the ID of the target face.
The optional argument FRAME is ignored, since the internal face ID
of a face name is the same for all frames."
(check-face face)
- (get face 'face))
-
+ (or (get face 'face)
+ (face-id (get face 'face-alias))))
(defun face-equal (face1 face2 &optional frame)
"Non-nil if faces FACE1 and FACE2 are equal.
(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.
(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))
((: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)
;; 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"))))
(save-excursion
(set-buffer standard-output)
(dolist (f face)
+ (if (stringp f) (setq f (intern f)))
(insert "Face: " (symbol-name f))
(if (not (facep f))
(insert " undefined face.\n")
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))
(defun face-spec-set (face spec &optional frame)
"Set FACE's attributes according to the first matching entry in SPEC.
FRAME is the frame whose frame-local face is set. FRAME nil means
-do it on all frames. See `defface' for information about SPEC.
-If SPEC is nil, do nothing."
+do it on all frames (and change the default for new frames).
+See `defface' for information about SPEC. If SPEC is nil, do nothing."
(let ((attrs (face-spec-choose spec frame)))
(when spec
- (face-spec-reset-face face frame))
+ (face-spec-reset-face face (or frame t)))
(while attrs
(let ((attribute (car attrs))
(value (car (cdr attrs))))
;; Support some old-style attribute names and values.
(case attribute
- (:bold (setq attribute :weight value (if value 'bold 'normal)))
- (:italic (setq attribute :slant value (if value 'italic 'normal)))
- ((:foreground :background)
- ;; Compatibility with 20.x. Some bogus face specs seem to
- ;; exist containing things like `:foreground nil'.
- (if (null value) (setq value 'unspecified)))
- (t (unless (assq attribute face-x-resources)
- (setq attribute nil))))
+ (:bold (setq attribute :weight value (if value 'bold 'normal)))
+ (:italic (setq attribute :slant value (if value 'italic 'normal)))
+ ((:foreground :background)
+ ;; Compatibility with 20.x. Some bogus face specs seem to
+ ;; exist containing things like `:foreground nil'.
+ (if (null value) (setq value 'unspecified)))
+ (t (unless (assq attribute face-x-resources)
+ (setq attribute nil))))
(when attribute
- (set-face-attribute face frame attribute value)))
+ ;; If frame is nil, set the default for new frames.
+ ;; Existing frames are handled below.
+ (set-face-attribute face (or frame t) attribute value)))
(setq attrs (cdr (cdr attrs)))))
- ;; When we reset the face based on its spec, then it is unmodified
- ;; as far as Custom is concerned.
- (if (null frame)
- (put (or (get face 'face-alias) face) 'face-modified nil)))
+ (unless frame
+ ;; When we reset the face based on its spec, then it is unmodified
+ ;; as far as Custom is concerned.
+ (put (or (get face 'face-alias) face) 'face-modified nil)
+ ;; Set each frame according to the rules implied by SPEC.
+ (dolist (frame (frame-list))
+ (face-spec-set face spec frame))))
(defun face-attr-match-p (face attrs &optional frame)
(const light)
(const :tag "automatic" 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))
+ (terminal-bg-mode (terminal-parameter frame 'background-mode))
+ (tty-type (tty-type frame))
(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))
+ (terminal-bg-mode)
+ ((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 '+ (color-values bg-color frame))
;; Just looking at the screen, colors whose
;; values add up to .6 of the white total
'light)
(t 'dark)))
(display-type
- (cond ((null window-system)
+ (cond ((null (window-system frame))
(if (tty-display-color-p frame) 'color 'mono))
((display-color-p frame)
'color)
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))
+ ;; 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)))
+ ;; Make sure the tool-bar is ready to be enabled. The
+ ;; `tool-bar-lines' frame parameter will not take effect
+ ;; without this call.
+ (tool-bar-setup frame)
+ (if (null visibility-spec)
(make-frame-visible frame)
(modify-frame-parameters frame (list visibility-spec)))
(setq success t))
(condition-case ()
(progn
(face-spec-set face (face-user-default-spec face) frame)
- (if (memq window-system '(x w32 mac))
+ (if (memq (window-system frame) '(x w32 mac))
(make-face-x-resource-internal face frame))
(internal-merge-in-global-face face frame))
(error nil)))
(let ((frame (make-terminal-frame parameters))
success)
(unwind-protect
- (progn
+ (with-selected-frame frame
(tty-handle-reverse-video frame (frame-parameters frame))
+
+ ;; 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)
+ (tty-run-terminal-initialization frame)
(frame-set-background-mode frame)
(face-set-after-frame-default frame)
(setq success t))
(delete-frame frame)))
frame))
+(defun tty-find-type (pred type)
+ "Return the longest prefix of TYPE to which PRED returns non-nil.
+TYPE should be a tty type name such as \"xterm-16color\".
+
+The function tries only those prefixes that are followed by a
+dash or underscore in the original type name, like \"xterm\" in
+the above example."
+ (let (hyphend)
+ (while (and type
+ (not (funcall pred type)))
+ ;; Strip off last hyphen and what follows, then try again
+ (setq type
+ (if (setq hyphend (string-match "[-_][^-_]+$" type))
+ (substring type 0 hyphend)
+ nil))))
+ type)
+
+(defun tty-run-terminal-initialization (frame &optional type)
+ "Run the special initialization code for the terminal type of FRAME.
+The optional TYPE parameter may be used to override the autodetected
+terminal type to a different value."
+ (setq type (or type (tty-type frame)))
+ ;; Load library for our terminal type.
+ ;; User init file can set term-file-prefix to nil to prevent this.
+ (with-selected-frame frame
+ (unless (or (null term-file-prefix)
+ ;; Don't reinitialize the terminal each time a new
+ ;; frame is opened on it.
+ (terminal-parameter frame 'terminal-initted))
+ (let* (term-init-func)
+ ;; First, load the terminal initialization file, if it is
+ ;; available and it hasn't been loaded already.
+ (tty-find-type #'(lambda (type)
+ (let ((file (locate-library (concat term-file-prefix type))))
+ (and file
+ (or (assoc file load-history)
+ (load file t t)))))
+ type)
+ ;; Next, try to find a matching initialization function, and call it.
+ (tty-find-type #'(lambda (type)
+ (fboundp (setq term-init-func
+ (intern (concat "terminal-init-" type)))))
+ type)
+ (when (fboundp term-init-func)
+ (funcall term-init-func))
+ (set-terminal-parameter frame 'terminal-initted term-init-func)))))
;; Called from C function init_display to initialize faces of the
;; dumped terminal frame on startup.