-\f
-;;; non-X-specific interface
-
-(defun make-face-bold (face &optional frame noerror)
- "Make the font of the given face be bold, if possible.
-If NOERROR is non-nil, return nil on failure."
- (interactive (list (read-face-name "Make which face bold: ")))
- ;; Set the bold-p flag, first of all.
- (internal-set-face-1 face nil t 10 frame)
- (if (and (eq frame t) (listp (face-font face t)))
- (set-face-font face (if (memq 'italic (face-font face t))
- '(bold italic) '(bold))
- t)
- (let (font)
- (if (null frame)
- (let ((frames (frame-list)))
- ;; Make this face bold in global-face-data.
- (make-face-bold face t noerror)
- ;; Make this face bold in each frame.
- (while frames
- (make-face-bold face (car frames) noerror)
- (setq frames (cdr frames))))
- (setq face (internal-get-face face frame))
- (setq font (or (face-font face frame)
- (face-font face t)))
- (if (listp font)
- (setq font nil))
- (setq font (or font
- (face-font 'default frame)
- (cdr (assq 'font (frame-parameters frame)))))
- (or (and font (make-face-bold-internal face frame font))
- ;; We failed to find a bold version of the font.
- noerror
- (error "No bold version of %S" font))))))
-
-(defun make-face-bold-internal (face frame font)
- (let (f2)
- (or (and (setq f2 (x-make-font-bold font))
- (internal-try-face-font face f2 frame))
- (and (setq f2 (x-make-font-demibold font))
- (internal-try-face-font face f2 frame)))))
-
-(defun make-face-italic (face &optional frame noerror)
- "Make the font of the given face be italic, if possible.
-If NOERROR is non-nil, return nil on failure."
- (interactive (list (read-face-name "Make which face italic: ")))
- ;; Set the italic-p flag, first of all.
- (internal-set-face-1 face nil t 11 frame)
- (if (and (eq frame t) (listp (face-font face t)))
- (set-face-font face (if (memq 'bold (face-font face t))
- '(bold italic) '(italic))
- t)
- (let (font)
- (if (null frame)
- (let ((frames (frame-list)))
- ;; Make this face italic in global-face-data.
- (make-face-italic face t noerror)
- ;; Make this face italic in each frame.
- (while frames
- (make-face-italic face (car frames) noerror)
- (setq frames (cdr frames))))
- (setq face (internal-get-face face frame))
- (setq font (or (face-font face frame)
- (face-font face t)))
- (if (listp font)
- (setq font nil))
- (setq font (or font
- (face-font 'default frame)
- (cdr (assq 'font (frame-parameters frame)))))
- (or (and font (make-face-italic-internal face frame font))
- ;; We failed to find an italic version of the font.
- noerror
- (error "No italic version of %S" font))))))
-
-(defun make-face-italic-internal (face frame font)
- (let (f2)
- (or (and (setq f2 (x-make-font-italic font))
- (internal-try-face-font face f2 frame))
- (and (setq f2 (x-make-font-oblique font))
- (internal-try-face-font face f2 frame)))))
-
-(defun make-face-bold-italic (face &optional frame noerror)
- "Make the font of the given face be bold and italic, if possible.
-If NOERROR is non-nil, return nil on failure."
- (interactive (list (read-face-name "Make which face bold-italic: ")))
- ;; Set the bold-p and italic-p flags, first of all.
- (internal-set-face-1 face nil t 10 frame)
- (internal-set-face-1 face nil t 11 frame)
- (if (and (eq frame t) (listp (face-font face t)))
- (set-face-font face '(bold italic) t)
- (let (font)
- (if (null frame)
- (let ((frames (frame-list)))
- ;; Make this face bold-italic in global-face-data.
- (make-face-bold-italic face t noerror)
- ;; Make this face bold in each frame.
- (while frames
- (make-face-bold-italic face (car frames) noerror)
- (setq frames (cdr frames))))
- (setq face (internal-get-face face frame))
- (setq font (or (face-font face frame)
- (face-font face t)))
- (if (listp font)
- (setq font nil))
- (setq font (or font
- (face-font 'default frame)
- (cdr (assq 'font (frame-parameters frame)))))
- (or (and font (make-face-bold-italic-internal face frame font))
- ;; We failed to find a bold italic version.
- noerror
- (error "No bold italic version of %S" font))))))
-
-(defun make-face-bold-italic-internal (face frame font)
- (let (f2 f3)
- (or (and (setq f2 (x-make-font-italic font))
- (not (equal font f2))
- (setq f3 (x-make-font-bold f2))
- (not (equal f2 f3))
- (internal-try-face-font face f3 frame))
- (and (setq f2 (x-make-font-oblique font))
- (not (equal font f2))
- (setq f3 (x-make-font-bold f2))
- (not (equal f2 f3))
- (internal-try-face-font face f3 frame))
- (and (setq f2 (x-make-font-italic font))
- (not (equal font f2))
- (setq f3 (x-make-font-demibold f2))
- (not (equal f2 f3))
- (internal-try-face-font face f3 frame))
- (and (setq f2 (x-make-font-oblique font))
- (not (equal font f2))
- (setq f3 (x-make-font-demibold f2))
- (not (equal f2 f3))
- (internal-try-face-font face f3 frame)))))
-
-(defun make-face-unbold (face &optional frame noerror)
- "Make the font of the given face be non-bold, if possible.
-If NOERROR is non-nil, return nil on failure."
- (interactive (list (read-face-name "Make which face non-bold: ")))
- ;; Clear the bold-p flag, first of all.
- (internal-set-face-1 face nil nil 10 frame)
- (if (and (eq frame t) (listp (face-font face t)))
- (set-face-font face (if (memq 'italic (face-font face t))
- '(italic) nil)
- t)
- (let (font font1)
- (if (null frame)
- (let ((frames (frame-list)))
- ;; Make this face unbold in global-face-data.
- (make-face-unbold face t noerror)
- ;; Make this face unbold in each frame.
- (while frames
- (make-face-unbold face (car frames) noerror)
- (setq frames (cdr frames))))
- (setq face (internal-get-face face frame))
- (setq font1 (or (face-font face frame)
- (face-font face t)))
- (if (listp font1)
- (setq font1 nil))
- (setq font1 (or font1
- (face-font 'default frame)
- (cdr (assq 'font (frame-parameters frame)))))
- (setq font (and font1 (x-make-font-unbold font1)))
- (or (if font (internal-try-face-font face font frame))
- noerror
- (error "No unbold version of %S" font1))))))
-
-(defun make-face-unitalic (face &optional frame noerror)
- "Make the font of the given face be non-italic, if possible.
-If NOERROR is non-nil, return nil on failure."
- (interactive (list (read-face-name "Make which face non-italic: ")))
- ;; Clear the italic-p flag, first of all.
- (internal-set-face-1 face nil nil 11 frame)
- (if (and (eq frame t) (listp (face-font face t)))
- (set-face-font face (if (memq 'bold (face-font face t))
- '(bold) nil)
- t)
- (let (font font1)
- (if (null frame)
- (let ((frames (frame-list)))
- ;; Make this face unitalic in global-face-data.
- (make-face-unitalic face t noerror)
- ;; Make this face unitalic in each frame.
- (while frames
- (make-face-unitalic face (car frames) noerror)
- (setq frames (cdr frames))))
- (setq face (internal-get-face face frame))
- (setq font1 (or (face-font face frame)
- (face-font face t)))
- (if (listp font1)
- (setq font1 nil))
- (setq font1 (or font1
- (face-font 'default frame)
- (cdr (assq 'font (frame-parameters frame)))))
- (setq font (and font1 (x-make-font-unitalic font1)))
- (or (if font (internal-try-face-font face font frame))
- noerror
- (error "No unitalic version of %S" font1))))))
-\f
-(defvar list-faces-sample-text
- "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "*Text string to display as the sample text for `list-faces-display'.")
-
-;; The name list-faces would be more consistent, but let's avoid a conflict
-;; with Lucid, which uses that name differently.
-(defun list-faces-display ()
- "List all faces, using the same sample text in each.
-The sample text is a string that comes from the variable
-`list-faces-sample-text'.
-
-It is possible to give a particular face name different appearances in
-different frames. This command shows the appearance in the
-selected frame."
- (interactive)
- (let ((faces (sort (face-list) (function string-lessp)))
- (face nil)
- (frame (selected-frame))
- disp-frame window)
- (with-output-to-temp-buffer "*Faces*"
- (save-excursion
- (set-buffer standard-output)
- (setq truncate-lines t)
- (while faces
- (setq face (car faces))
- (setq faces (cdr faces))
- (insert (format "%25s " (symbol-name face)))
- (let ((beg (point)))
- (insert list-faces-sample-text)
- (insert "\n")
- (put-text-property beg (1- (point)) 'face face)
- ;; If the sample text has multiple lines, line up all of them.
- (goto-char beg)
- (forward-line 1)
- (while (not (eobp))
- (insert " ")
- (forward-line 1))))
- (goto-char (point-min)))
- (print-help-return-message))
- ;; If the *Faces* buffer appears in a different frame,
- ;; copy all the face definitions from FRAME,
- ;; so that the display will reflect the frame that was selected.
- (setq window (get-buffer-window (get-buffer "*Faces*") t))
- (setq disp-frame (if window (window-frame window)
- (car (frame-list))))
- (or (eq frame disp-frame)
- (let ((faces (face-list)))
- (while faces
- (copy-face (car faces) (car faces) frame disp-frame)
- (setq faces (cdr faces)))))))
-
-(defun describe-face (face)
- "Display the properties of face FACE."
- (interactive (list (read-face-name "Describe face: ")))
- (with-output-to-temp-buffer "*Help*"
- (princ "Properties of face `")
- (princ (face-name face))
- (princ "':") (terpri)
- (princ "Foreground: ") (princ (face-foreground face)) (terpri)
- (princ "Background: ") (princ (face-background face)) (terpri)
- (princ " Font: ") (princ (face-font face)) (terpri)
- (princ "Underlined: ") (princ (if (face-underline-p face) "yes" "no")) (terpri)
- (princ " Stipple: ") (princ (or (face-stipple face) "none")) (terpri)
- (terpri)
- (princ "Documentation:") (terpri)
- (let ((doc (face-documentation face)))
- (if doc
- (princ doc)
- (princ "not documented as a face.")))
- (print-help-return-message)))
-\f
-;;; Setting a face based on a SPEC.
-
-(defun face-attr-match-p (face attrs &optional frame)
- (or frame (setq frame (selected-frame)))
- (and (face-attr-match-1 face frame attrs ':inverse-video
- 'face-inverse-video-p)
- (if (face-inverse-video-p face frame)
- (and
- (face-attr-match-1 face frame attrs
- ':foreground 'face-background
- (cdr (assq 'foreground-color
- (frame-parameters frame))))
- (face-attr-match-1 face frame attrs
- ':background 'face-foreground
- (cdr (assq 'background-color
- (frame-parameters frame)))))
- (and
- (face-attr-match-1 face frame attrs ':foreground 'face-foreground)
- (face-attr-match-1 face frame attrs ':background 'face-background)))
- (face-attr-match-1 face frame attrs ':stipple 'face-stipple)
- (face-attr-match-1 face frame attrs ':bold 'face-bold-p)
- (face-attr-match-1 face frame attrs ':italic 'face-italic-p)
- (face-attr-match-1 face frame attrs ':underline 'face-underline-p)
-))
-
-(defun face-attr-match-1 (face frame plist property function
- &optional defaultval)
- (while (and plist (not (eq (car plist) property)))
- (setq plist (cdr (cdr plist))))
- (eq (funcall function face frame)
- (if plist
- (nth 1 plist)
- (or defaultval
- (funcall function 'default frame)))))
-
-(defun face-spec-match-p (face spec &optional 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))
-
-(defun face-attr-construct (face &optional frame)
- "Return a defface-style attribute list for FACE, as it exists on FRAME."
- (let (result)
- (if (face-inverse-video-p face frame)
- (progn
- (setq result (cons ':inverse-video (cons t result)))
- (or (face-attr-match-1 face frame nil
- ':foreground 'face-background
- (cdr (assq 'foreground-color
- (frame-parameters frame))))
- (setq result (cons ':foreground
- (cons (face-foreground face frame) result))))
- (or (face-attr-match-1 face frame nil
- ':background 'face-foreground
- (cdr (assq 'background-color
- (frame-parameters frame))))
- (setq result (cons ':background
- (cons (face-background face frame) result)))))
- (if (face-foreground face frame)
- (setq result (cons ':foreground
- (cons (face-foreground face frame) result))))
- (if (face-background face frame)
- (setq result (cons ':background
- (cons (face-background face frame) result)))))
- (if (face-stipple face frame)
- (setq result (cons ':stipple
- (cons (face-stipple face frame) result))))
- (if (face-bold-p face frame)
- (setq result (cons ':bold
- (cons (face-bold-p face frame) result))))
- (if (face-italic-p face frame)
- (setq result (cons ':italic
- (cons (face-italic-p face frame) result))))
- (if (face-underline-p face frame)
- (setq result (cons ':underline
- (cons (face-underline-p face frame) result))))
- result))
-
-;; Choose the proper attributes for FRAME, out of SPEC.
-(defun face-spec-choose (spec &optional frame)
- (or 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))
- (when (face-spec-set-match-display display frame)
- (setq result attrs tail nil))))
- result))
-
-(defun face-spec-set (face spec &optional frame)
- "Set FACE's face attributes according to the first matching entry in SPEC.
-If optional FRAME is non-nil, set it for that frame only.
-If it is nil, then apply SPEC to each frame individually.
-See `defface' for information about SPEC."
- (if frame
- (let ((attrs (face-spec-choose spec frame)))
- (when attrs
- ;; If the font was set automatically, clear it out
- ;; to allow it to be set it again.
- (unless (face-font-explicit face frame)
- (set-face-font face nil frame))
- (modify-face face '(nil) '(nil) nil nil nil nil nil frame)
- (face-spec-set-1 face frame attrs ':foreground 'set-face-foreground)
- (face-spec-set-1 face frame attrs ':background 'set-face-background)
- (face-spec-set-1 face frame attrs ':stipple 'set-face-stipple)
- (face-spec-set-1 face frame attrs ':bold 'set-face-bold-p)
- (face-spec-set-1 face frame attrs ':italic 'set-face-italic-p)
- (face-spec-set-1 face frame attrs ':underline 'set-face-underline-p)
- (face-spec-set-1 face frame attrs ':inverse-video
- 'set-face-inverse-video-p)))
- (let ((frames (frame-list))
- frame)
- (while frames
- (setq frame (car frames)
- frames (cdr frames))
- (face-spec-set face (or (get face 'saved-face)
- (get face 'face-defface-spec))
- frame)
- (face-spec-set face spec frame)))))
-
-(defun face-spec-set-1 (face frame plist property function)
- (while (and plist (not (eq (car plist) property)))
- (setq plist (cdr (cdr plist))))
- (if plist
- (funcall function face (nth 1 plist) frame)))
-
-(defun face-spec-set-match-display (display frame)
- "Non-nil iff DISPLAY matches FRAME.
-DISPLAY is part of a spec such as can be used in `defface'.
-If FRAME is nil, the current FRAME is used."
- (let* ((conjuncts display)
- conjunct req options
- ;; t means we have succeeded against all
- ;; the conjunts in DISPLAY that have been tested so far.
- (match t))
- (if (eq conjuncts t)
- (setq conjuncts nil))
- (while (and conjuncts match)
- (setq conjunct (car conjuncts)
- conjuncts (cdr conjuncts)
- req (car conjunct)
- options (cdr conjunct)
- match (cond ((eq req 'type)
- (memq window-system options))
- ((eq req 'class)
- (memq (frame-parameter frame 'display-type) options))
- ((eq req 'background)
- (memq (frame-parameter frame 'background-mode)
- options))
- (t
- (error "Unknown req `%S' with options `%S'"
- req options)))))
- match))
-\f
-;; Like x-create-frame but also set up the faces.
-
-(defun x-create-frame-with-faces (&optional parameters)
- ;; Read this frame's geometry resource, if it has an explicit name,
- ;; and put the specs into PARAMETERS.
- (let* ((name (or (cdr (assq 'name parameters))
- (cdr (assq 'name default-frame-alist))))
- (x-resource-name name)
- (res-geometry (if name (x-get-resource "geometry" "Geometry"))))
- (if res-geometry
- (let ((parsed (x-parse-geometry res-geometry)))
- ;; If the resource specifies a position,
- ;; call the position and size "user-specified".
- (if (or (assq 'top parsed) (assq 'left parsed))
- (setq parsed (append '((user-position . t) (user-size . t))
- parsed)))
- ;; Put the geometry parameters at the end.
- ;; Copy default-frame-alist so that they go after it.
- (setq parameters (append parameters default-frame-alist parsed)))))
-
- (if default-enable-multibyte-characters
- ;; If an ASCII font is specified in PARAMETERS, we try to create
- ;; a fontset from it, and use it for the new frame.
- (condition-case nil
- (let ((font (cdr (assq 'font parameters))))
- (if (and font
- (not (query-fontset font)))
- (setq parameters
- (cons (cons 'font (create-fontset-from-ascii-font font))
- parameters))))
- (error nil)))
-
- (let (frame)
- (if (null global-face-data)
- (progn
- (setq frame (x-create-frame parameters))
- (frame-set-background-mode frame))
- (let* ((visibility-spec (assq 'visibility parameters))
- success faces rest)
- (setq frame (x-create-frame (cons '(visibility . nil) parameters)))
- (unwind-protect
- (progn
- ;; Copy the face alist, copying the face vectors
- ;; and emptying out their attributes.
- (setq faces
- (mapcar '(lambda (elt)
- (cons (car elt)
- (vector 'face
- (face-name (cdr elt))
- (face-id (cdr elt))
- nil
- nil nil nil nil
- nil nil nil nil)))
- global-face-data))
- (set-frame-face-alist frame faces)
-
- ;; Handle the reverse-video frame parameter
- ;; and X resource. x-create-frame does not handle this one.
- (if (cdr (or (assq 'reverse parameters)
- (assq 'reverse default-frame-alist)
- (let ((resource (x-get-resource "reverseVideo"
- "ReverseVideo")))
- (if resource
- (cons nil (member (downcase resource)
- '("on" "true")))))))
- (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 'border-color params)))
- (modify-frame-parameters frame
- (list (cons 'border-color fg))))
- (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))))))
-
- (frame-set-background-mode frame)
-
- (face-set-after-frame-default frame)
-
- ;; Make the frame visible, if desired.
- (if (null visibility-spec)
- (make-frame-visible frame)
- (modify-frame-parameters frame (list visibility-spec)))
- (setq success t))
- (or success
- (delete-frame frame)))))
- frame))
-
-;; Update a frame's faces after the frame font changes.
-;; This is called from modify-frame-parameters
-;; as well as from elsewhere in this file.
-(defun face-set-after-frame-default (frame)
- (let ((rest (frame-face-alist frame)))
- (while rest
- ;; Set up each face, first from the defface information,
- ;; then the global face data, and then the X resources.
- (let* ((face (car (car rest)))
- (spec (or (get face 'saved-face)
- (get face 'face-defface-spec)))
- (global (cdr (assq face global-face-data)))
- (local (cdr (car rest))))
- (when spec
- (face-spec-set face spec frame))
- (face-fill-in face global frame)
- (make-face-x-resource-internal local frame))
- (setq rest (cdr rest)))))
-
-(defcustom frame-background-mode nil
- "*The brightness of the background.
-Set this to the symbol dark if your background color is dark, light if
-your background is light, or nil (default) if you want Emacs to
-examine the brightness for you."
- :group 'faces
- :set #'(lambda (var value)
- (set var value)
- (mapcar 'frame-set-background-mode (frame-list)))
- :initialize 'custom-initialize-changed
- :type '(choice (choice-item dark)
- (choice-item light)
- (choice-item :tag "default" nil)))
-
-(defun frame-set-background-mode (frame)
- "Set up the `background-mode' and `display-type' frame parameters for FRAME."
- (unless (eq (framep frame) t)
- (let ((bg-resource (x-get-resource ".backgroundMode"
- "BackgroundMode"))
- (params (frame-parameters frame))
- (bg-mode))
- (setq bg-mode
- (cond (frame-background-mode)
- (bg-resource (intern (downcase bg-resource)))
- ((< (apply '+ (x-color-values
- (cdr (assq 'background-color params))
- frame))
- ;; Just looking at the screen,
- ;; colors whose values add up to .6 of the white total
- ;; still look dark to me.
- (* (apply '+ (x-color-values "white" frame)) .6))
- 'dark)
- (t 'light)))
- (modify-frame-parameters frame
- (list (cons 'background-mode bg-mode)
- (cons 'display-type
- (cond ((x-display-color-p frame)
- 'color)
- ((x-display-grayscale-p frame)
- 'grayscale)
- (t 'mono))))))))
-
-;; Update a frame's faces when we change its default font.
-(defun frame-update-faces (frame) nil)
-
-;; Update the colors of FACE, after FRAME's own colors have been changed.
-;; This applies only to faces with global color specifications
-;; that are not simple constants.
-(defun frame-update-face-colors (frame)
- (frame-set-background-mode frame)
- (let ((faces global-face-data))
- (while faces
- (condition-case nil
- (let* ((data (cdr (car faces)))
- (face (car (car faces)))
- (foreground (face-foreground data))
- (background (face-background data)))
- ;; If the global spec is a specific color,
- ;; which doesn't depend on the frame's attributes,
- ;; we don't need to recalculate it now.
- (or (listp foreground)
- (setq foreground nil))
- (or (listp background)
- (setq background nil))
- ;; If we are going to frob this face at all,
- ;; reinitialize it first.
- (if (or foreground background)
- (progn (set-face-foreground face nil frame)
- (set-face-background face nil frame)))
- (if foreground
- (face-try-color-list 'set-face-foreground
- face foreground frame))
- (if background
- (face-try-color-list 'set-face-background
- face background frame)))
- (error nil))
- (setq faces (cdr faces)))))
-
-;; Fill in the face FACE from frame-independent face data DATA.
-;; DATA should be the non-frame-specific ("global") face vector
-;; for the face. FACE should be a face name or face object.
-;; FRAME is the frame to act on; it must be an actual frame, not nil or t.
-(defun face-fill-in (face data frame)
- (condition-case nil
- (let ((foreground (face-foreground data))
- (background (face-background data))
- (font (face-font data))
- (stipple (face-stipple data)))
- (if (face-underline-p data)
- (set-face-underline-p face (face-underline-p data) frame))
- (if foreground
- (face-try-color-list 'set-face-foreground
- face foreground frame))
- (if background
- (face-try-color-list 'set-face-background
- face background frame))
- (if (listp font)
- (let ((bold (memq 'bold font))
- (italic (memq 'italic font)))
- (cond ((and bold italic)
- (make-face-bold-italic face frame))
- (bold
- (make-face-bold face frame))
- (italic
- (make-face-italic face frame))))
- (if font
- (set-face-font face font frame)))
- (if stipple
- (set-face-stipple face stipple frame)))
- (error nil)))
-
-;; Assuming COLOR is a valid color name,
-;; return t if it can be displayed on FRAME.
-(defun face-color-supported-p (frame color background-p)
- (and window-system
- (or (x-display-color-p frame)
- ;; A black-and-white display can implement these.
- (member color '("black" "white"))
- ;; A black-and-white display can fake gray for background.
- (and background-p
- (face-color-gray-p color frame))
- ;; A grayscale display can implement colors that are gray (more or less).
- (and (x-display-grayscale-p frame)
- (face-color-gray-p color frame)))))
-
-;; Use FUNCTION to store a color in FACE on FRAME.
-;; COLORS is either a single color or a list of colors.
-;; If it is a list, try the colors one by one until one of them
-;; succeeds. We signal an error only if all the colors failed.
-;; t as COLORS or as an element of COLORS means to invert the face.
-;; That can't fail, so any subsequent elements after the t are ignored.
-(defun face-try-color-list (function face colors frame)
- (if (stringp colors)
- (if (face-color-supported-p frame colors
- (eq function 'set-face-background))
- (funcall function face colors frame))
- (if (eq colors t)
- (set-face-inverse-video-p face t frame)
- (let (done)
- (while (and colors (not done))
- (if (or (memq (car colors) '(t underline nil))
- (face-color-supported-p frame (car colors)
- (eq function 'set-face-background)))
- (if (cdr colors)
- ;; If there are more colors to try, catch errors
- ;; and set `done' if we succeed.
- (condition-case nil
- (progn
- (cond ((eq (car colors) t)
- (set-face-inverse-video-p face t frame))
- ((eq (car colors) 'underline)
- (set-face-underline-p face t frame))
- (t
- (funcall function face (car colors) frame)))
- (setq done t))
- (error nil))
- ;; If this is the last color, let the error get out if it fails.
- ;; If it succeeds, we will exit anyway after this iteration.
- (cond ((eq (car colors) t)
- (set-face-inverse-video-p face t frame))
- ((eq (car colors) 'underline)
- (set-face-underline-p face t frame))
- (t
- (funcall function face (car colors) frame)))))
- (setq colors (cdr colors)))))))
-
-;;; Make the standard faces.
-;;; The C code knows the default and modeline faces as faces 0 and 1,
-;;; so they must be the first two faces made.
-(make-face 'default)
-(make-face 'modeline)
-(make-face 'highlight)
-
-;; These aren't really special in any way, but they're nice to have around.
-
-(make-face 'bold)
-(make-face 'italic)
-(make-face 'bold-italic)
-(make-face 'region)
-(make-face 'secondary-selection)
-(make-face 'underline)
-
-(setq region-face (face-id 'region))
-
-(defgroup basic-faces nil
- "The standard faces of Emacs."
- :prefix "huh"
- :group 'faces)