(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"))))
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))
(unless frame
(setq frame (selected-frame)))
(let ((tail spec)
- result all)
+ result defaults)
(while tail
(let* ((entry (pop tail))
(display (car entry))
- (attrs (cdr entry)))
- (when (face-spec-set-match-display display frame)
- (setq result (if (null (cdr attrs)) ;; was (listp (car attrs))
- ;; Old-style entry, the attribute list is the
- ;; first element.
- (car attrs)
- attrs))
- (if (eq display t)
- (setq all result result nil)
+ (attrs (cdr entry))
+ thisval)
+ ;; Get the attributes as actually specified by this alternative.
+ (setq thisval
+ (if (null (cdr attrs)) ;; was (listp (car attrs))
+ ;; Old-style entry, the attribute list is the
+ ;; first element.
+ (car attrs)
+ attrs))
+
+ ;; If the condition is `default', that sets the default
+ ;; for following conditions.
+ (if (eq display 'default)
+ (setq defaults thisval)
+ ;; Otherwise, if it matches, use it.
+ (when (face-spec-set-match-display display frame)
+ (setq result thisval)
(setq tail nil)))))
- (if all (append result all) result)))
+ (if defaults (append result defaults) result)))
(defun face-spec-reset-face (face &optional 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 (?).
- 'dark)
- ;; Unspecified frame background color can only happen
- ;; on tty's.
- ((member bg-color '(unspecified "unspecified-bg"))
- '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
- '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
'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)
(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
(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)))
(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)))
(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)))
(setq success t))
(unless success
(delete-frame frame)))
:group 'basic-faces)
(defface mode-line-inactive
- '((t
+ '((default
:inherit mode-line)
(((type x w32 mac) (background light) (class color))
:weight light
(put 'modeline-inactive 'face-alias 'mode-line-inactive)
(defface header-line
- '((t
+ '((default
:inherit mode-line)
(((type tty))
;; This used to be `:inverse-video t', but that doesn't look very
(defface tool-bar
- '((t
+ '((default
:box (:line-width 1 :style released-button)
:foreground "black")
(((type x w32 mac) (class color))
:group 'font-lock ; like `show-trailing-whitespace'
:group 'basic-faces)
-
-;; Make escape characters stand out in display
-
-(defface escape-glyph
- '((t :inherit secondary-selection))
- "Basic face for displaying \\ and ^ in multichar glyphs.
-It is also used for ... in ellipses."
+(defface escape-glyph '((((background dark)) :foreground "cyan")
+ (((type pc)) :foreground "magenta")
+ (t :foreground "blue"))
+ "Face for characters displayed as ^-sequences or \-sequences."
:group 'basic-faces)
-
-(or standard-display-table
- ;; avoid using autoloaded make-display-table here
- (setq standard-display-table (make-char-table 'display-table nil)))
-
-(let* ((face (lsh (face-id 'escape-glyph) 19))
- (backslash (+ face ?\\))
- (dot (+ face ?.)))
- (set-char-table-extra-slot standard-display-table 2 backslash)
- (aset standard-display-table 2208 (vector backslash ?\s))
- (aset standard-display-table 2221 (vector backslash ?-))
- (set-char-table-extra-slot standard-display-table 3 (+ face ?^))
- (set-char-table-extra-slot standard-display-table 4 (vector dot dot dot)))
-
-
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Manipulating font names.