(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
+ '(("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't be loaded, try ALTERNATIVE1, then
+ALTERNATIVE2 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))
(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)
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))
"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)
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
(if (member color '(unspecified "unspecified-bg" "unspecified-fg"))
nil
- (if (member (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)
\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
(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)
;; 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)))))))
-
+ (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 (memq window-system '(x w32 mac))
+ (make-face-x-resource-internal face frame)))
;; Initialize attributes from frame parameters.
(let ((params '((foreground-color default :foreground)
(set-face-attribute face frame attr value)))
(setq params (cdr params)))))
+(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)
"Create a frame from optional frame parameters 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
;; 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))
+ (((class color grayscale) (background light))
+ (:inherit mode-line
+ :background "grey90" :foreground "grey20"
+ :box (:line-width 1 :style released-button)))
+ (((class color grayscale) (background dark))
+ (:inherit mode-line
+ :background "grey20" :foreground "grey90"
+ :box (:line-width 1 :style released-button)))
+ (((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)))
"Basic header-line face."
(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))