(set-default symbol value)
(internal-set-font-selection-order value)))
-;; This is defined originally in {w32,x}faces.c.
+
+;; This is defined originally in xfaces.c.
(defcustom face-font-family-alternatives
'(("courier" "fixed")
("helv" "helvetica" "arial" "fixed"))
(internal-set-alternative-font-family-alist value)))
+;; This is defined originally in xfaces.c.
+(defcustom face-font-registry-alternatives
+ '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk*")
+ ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
+ ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
+ ("muletibetan-2" "muletibetan-0"))
+ "*Alist of alternative font registry names.
+Each element has the the form (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...).
+If fonts of registry REGISTRY can be loaded, font selection
+tries to find a best matching font among all fonts of registry
+REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
+ :tag "Alternative font registries to try."
+ :type '(repeat (repeat string))
+ :version "21.1"
+ :group 'font-selection
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (internal-set-alternative-font-registry-alist value)))
+
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Creation, copying.
(defun set-face-attributes-from-resources (face frame)
"Set attributes of FACE from X resources for FRAME."
- (when (memq (framep frame) '(x w32))
+ (when (memq (framep frame) '(x w32 mac))
(dolist (definition face-x-resources)
(let ((attribute (car definition)))
(dolist (entry (cdr definition))
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame."
- (internal-get-lisp-face-attribute face :foreground frame))
+ (let ((value (internal-get-lisp-face-attribute face :foreground frame)))
+ (if (eq value 'unspecified)
+ nil
+ value)))
(defun face-background (face &optional frame)
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame."
- (internal-get-lisp-face-attribute face :background frame))
+ (let ((value (internal-get-lisp-face-attribute face :background frame)))
+ (if (eq value 'unspecified)
+ nil
+ value)))
(defun face-stipple (face &optional frame)
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
If FRAME is omitted or nil, use the selected frame."
- (internal-get-lisp-face-attribute face :stipple frame))
+ (let ((value (internal-get-lisp-face-attribute face :stipple frame)))
+ (if (eq value 'unspecified)
+ nil
+ value)))
(defalias 'face-background-pixmap 'face-stipple)
(memq italic '(italic oblique))))
-
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Face documentation.
((:height)
'integerp)
(:stipple
- (and (memq window-system '(x w32))
+ (and (memq window-system '(x w32 mac))
(mapcar #'list
(apply #'nconc
(mapcar (lambda (dir)
;; Terminal frames can support colors that don't appear
;; explicitly in VALID, using color approximation code
;; in tty-colors.el.
- (if (and (memq attribute '(:foreground :background))
- (not (memq window-system '(x w32 mac)))
- (not (member new-value
- '("unspecified"
- "unspecified-fg" "unspecified-bg"))))
- (setq new-value (car (tty-color-desc new-value frame))))
- (setq new-value (cdr (assoc new-value valid))))))
+ (when (and (memq attribute '(:foreground :background))
+ (not (memq window-system '(x w32 mac)))
+ (not (member new-value
+ '("unspecified"
+ "unspecified-fg" "unspecified-bg"))))
+ (setq new-value (car (tty-color-desc new-value frame))))
+ (when (assoc new-value valid)
+ (setq new-value (cdr (assoc new-value valid)))))))
((eq valid 'integerp)
(setq new-value (face-read-integer face old-value attribute-name)))
(t (error "Internal error")))
options (cdr conjunct)
match (cond ((eq req 'type)
(or (memq window-system 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)
(memq 'tty options))
(and (memq 'motif options)
(defun face-spec-choose (spec &optional frame)
- "Choose the proper attributes for FRAME, out of SPEC."
+ "Choose the proper attributes for FRAME, out of SPEC.
+If SPEC is nil, return nil."
(unless frame
(setq frame (selected-frame)))
(let ((tail spec)
result)
(while tail
- (let* ((entry (car tail))
- (display (nth 0 entry))
- (attrs (nth 1 entry)))
- (setq tail (cdr tail))
+ (let* ((entry (pop tail))
+ (display (car entry))
+ (attrs (cdr entry)))
(when (face-spec-set-match-display display frame)
- (setq result attrs tail nil))))
+ (setq result (if (listp (car attrs))
+ ;; Old-style entry, the attribute list is the
+ ;; first element.
+ (car attrs)
+ attrs)
+ tail nil))))
result))
(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."
+do it on all frames. See `defface' for information about SPEC.
+If SPEC is nil, do nothing."
(let ((attrs (face-spec-choose spec frame)))
(when attrs
(face-spec-reset-face face frame))
(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))))
(when attribute
"Return t if FACE, on FRAME, matches what SPEC says it should look like."
(face-attr-match-p face (face-spec-choose spec frame) frame))
+(defsubst face-default-spec (face)
+ "Return the default face-spec for FACE, ignoring any user customization.
+If there is no default for FACE, return nil."
+ (get face 'face-defface-spec))
+
+(defsubst face-user-default-spec (face)
+ "Return the user's customized face-spec for FACE, or the default if none.
+If there is neither a user setting or a default for FACE, return nil."
+ (or (get face 'saved-face)
+ (face-default-spec face)))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
The argument FRAME specifies which frame to try.
The value may be different for frames on different display types.
If FRAME doesn't support colors, the value is nil."
- (if (memq (framep (or frame (selected-frame))) '(x w32))
+ (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
(xw-defined-colors frame)
(mapcar 'car (tty-color-alist frame))))
(defalias 'x-defined-colors 'defined-colors)
If FRAME is omitted or nil, use the selected frame.
If COLOR is the symbol `unspecified' or one of the strings
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
- (if (memq color '(unspecified "unspecified-bg" "unspecified-fg"))
+ (if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
nil
- (if (memq (framep (or frame (selected-frame))) '(x w32))
+ (if (member (framep (or frame (selected-frame))) '(x w32 mac))
(xw-color-defined-p color frame)
(numberp (tty-color-translate color frame)))))
(defalias 'x-color-defined-p 'color-defined-p)
If FRAME cannot display COLOR, the value is nil.
If COLOR is the symbol `unspecified' or one of the strings
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
- (if (memq color '(unspecified "unspecified-fg" "unspecified-bg"))
+ (if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
nil
- (if (memq (framep (or frame (selected-frame))) '(x w32))
+ (if (memq (framep (or frame (selected-frame))) '(x w32 mac))
(xw-color-values color frame)
(tty-color-values color frame))))
(defalias 'x-color-values 'color-values)
The optional argument DISPLAY specifies which display to ask about.
DISPLAY should be either a frame or a display name (a string).
If omitted or nil, that stands for the selected frame's display."
- (if (memq (framep-on-display display) '(x w32))
+ (if (memq (framep-on-display display) '(x w32 mac))
(xw-display-color-p display)
(tty-display-color-p display)))
(defalias 'x-display-color-p 'display-color-p)
'dark)
;; Unspecified frame background color can only happen
;; on tty's.
- ((memq bg-color '(unspecified unspecified-bg))
+ ((member bg-color '(unspecified "unspecified-bg"))
'dark)
- ((eq bg-color 'unspecified-fg) ; inverted colors
+ ((equal bg-color "unspecified-fg") ; inverted colors
'light)
((>= (apply '+ (x-color-values bg-color frame))
;; Just looking at the screen, colors whose
(frame-parameter frame 'display-type)))
(unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
- (modify-frame-parameters frame
- (list (cons 'background-mode bg-mode)
- (cons 'display-type display-type)))
- ;; For all named faces, choose face specs matching the new frame
- ;; parameters.
- (dolist (face (face-list))
- (let ((spec (or (get face 'saved-face)
- (get face 'face-defface-spec))))
- (when spec
- (face-spec-set face spec frame)))))))
-
+ (let ((locally-modified-faces nil))
+ ;; Before modifying the frame parameters, we collect a list of
+ ;; faces that don't match what their face-spec says they should
+ ;; look like; we then avoid changing these faces below. A
+ ;; negative list is used on the assumption that most faces will
+ ;; be unmodified, so we can avoid consing in the common case.
+ (dolist (face (face-list))
+ (when (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
+ (list (cons 'background-mode bg-mode)
+ (cons 'display-type display-type)))
+ ;; For all named faces, choose face specs matching the new frame
+ ;; parameters, unless they have been locally modified.
+ (dolist (face (face-list))
+ (unless (memq face locally-modified-faces)
+ (face-spec-set face (face-user-default-spec face) frame)))))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"Set frame-local faces of FRAME from face specs and resources.
Initialize colors of certain faces from frame parameters."
(dolist (face (face-list))
- (let ((spec (or (get face 'saved-face)
- (get face 'face-defface-spec))))
- (when spec
- (face-spec-set face spec frame))
- (internal-merge-in-global-face face frame)
- (when (memq window-system '(x w32))
- (make-face-x-resource-internal face frame))))
+ (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))
+ (or (not (boundp 'inhibit-default-face-x-resources))
+ (not (eq face 'default))))
+ (make-face-x-resource-internal face frame)))
;; Initialize attributes from frame parameters.
(let ((params '((foreground-color default :foreground)
(scroll-bar-foreground scroll-bar :foreground)
(scroll-bar-background scroll-bar :background)
(mouse-color mouse :background))))
- (while params
- (let ((param-name (nth 0 (car params)))
- (face (nth 1 (car params)))
- (attr (nth 2 (car params)))
- value)
- (when (setq value (frame-parameter frame param-name))
- (set-face-attribute face frame attr value)))
- (setq params (cdr params)))))
+ (dolist (param params)
+ (let ((frame-param (frame-parameter frame (nth 0 param)))
+ (face (nth 1 param))
+ (attr (nth 2 param)))
+ (when (and frame-param
+ ;; Don't override face attributes explicitly
+ ;; specified for new frames.
+ (eq (face-attribute face attr t) 'unspecified))
+ (set-face-attribute face frame attr frame-param))))))
+
+
+(defun tty-handle-reverse-video (frame parameters)
+ "Handle the reverse-video frame parameter for terminal frames."
+ (when (cdr (or (assq 'reverse parameters)
+ (assq 'reverse default-frame-alist)))
+ (if (null window-system)
+ (setq inverse-video t))
+ (let* ((params (frame-parameters frame))
+ (bg (cdr (assq 'foreground-color params)))
+ (fg (cdr (assq 'background-color params))))
+ (modify-frame-parameters frame
+ (list (cons 'foreground-color fg)
+ (cons 'background-color bg)))
+ (if (equal bg (cdr (assq 'mouse-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'mouse-color fg))))
+ (if (equal bg (cdr (assq 'cursor-color params)))
+ (modify-frame-parameters frame
+ (list (cons 'cursor-color fg)))))))
(defun tty-create-frame-with-faces (&optional parameters)
success)
(unwind-protect
(progn
+ (tty-handle-reverse-video frame (frame-parameters frame))
(frame-set-background-mode frame)
(face-set-after-frame-default frame)
(setq success t))
(defface mode-line
- '((((type x w32) (class color))
+ '((((type x w32 mac) (class color))
(:box (:line-width 2 :style released-button)
:background "grey75" :foreground "black"))
(t
;; highlighting; this may be too confusing in general, although it
;; happens to look good with the only current use of header-lines,
;; the info browser. XXX
- (:underline t))
- (((class color) (background light))
- (:box (:line-width 1 :style released-button)
- :background "grey90" :foreground "grey20"
- :inherit mode-line))
- (((class color) (background dark))
- (:box (:line-width 1 :style released-button)
- :background "grey20" :foreground "grey90"
- :inherit mode-line))
- (((class mono))
- (:box (:line-width 1 :style released-button)
- :background "grey"
- :inherit mode-line))
+ :underline t)
+ (((class color grayscale) (background light))
+ :inherit mode-line
+ :background "grey90" :foreground "grey20"
+ :box nil)
+ (((class color grayscale) (background dark))
+ :inherit mode-line
+ :background "grey20" :foreground "grey90"
+ :box nil)
+ (((class mono) (background light))
+ :inherit mode-line
+ :background "white" :foreground "black"
+ :inverse-video nil
+ :box nil
+ :underline t)
+ (((class mono) (background dark))
+ :inherit mode-line
+ :background "black" :foreground "white"
+ :inverse-video nil
+ :box nil
+ :underline t)
(t
- (:inverse-video t)))
+ :inverse-video t))
"Basic header-line face."
:version "21.1"
:group 'basic-faces)
(defface tool-bar
- '((((type x w32) (class color))
+ '((((type x w32 mac) (class color))
(:box (:line-width 1 :style released-button)
:background "grey75" :foreground "black"))
(((type x) (class mono))
(defface menu
- '((((type x-toolkit)) ())
- (t (:inverse-video t)))
+ '((((type tty))
+ :inverse-video t)
+ (((type x-toolkit))
+ )
+ (t
+ :inverse-video t))
"Basic menu face."
:version "21.1"
:group 'menu