;;;; Functions for manipulating face vectors.
;;; A face vector is a vector of the form:
-;;; [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE INVERSE]
+;;; [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE
+;;; UNDERLINE-P INVERSE-VIDEO-P FONT-EXPLICIT-P BOLD-P ITALIC-P]
;;; Type checkers.
(defsubst internal-facep (x)
- (and (vectorp x) (= (length x) 10) (eq (aref x 0) 'face)))
+ (and (vectorp x) (= (length x) 12) (eq (aref x 0) 'face)))
(defun facep (x)
"Return t if X is a face name or an internal face vector."
If FRAME is omitted or nil, use the selected frame."
(aref (internal-get-face face frame) 3))
-(defun face-font-explicit (face &optional frame)
- "Return non-nil if this face's font was explicitly specified."
- (aref (internal-get-face face frame) 9))
-
(defun face-foreground (face &optional frame)
"Return the foreground color name of face FACE, or nil if unspecified.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is omitted or nil, use the selected frame."
(aref (internal-get-face face frame) 8))
+(defun face-font-explicit (face &optional frame)
+ "Return non-nil if this face's font was explicitly specified."
+ (aref (internal-get-face face frame) 9))
+
(defun face-bold-p (face &optional frame)
"Return non-nil if the font of FACE is bold.
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).
- The font default for a face is either nil, or a list
- of the form (bold), (italic) or (bold italic).
If FRAME is omitted or nil, use the selected frame."
- (let ((font (face-font face frame)))
- (if (stringp font)
- (not (equal font (x-make-font-unbold font)))
- (memq 'bold font))))
+ (aref (internal-get-face face frame) 10))
(defun face-italic-p (face &optional frame)
"Return non-nil if the font of FACE is italic.
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).
- The font default for a face is either nil, or a list
- of the form (bold), (italic) or (bold italic).
If FRAME is omitted or nil, use the selected frame."
- (let ((font (face-font face frame)))
- (if (stringp font)
- (not (equal font (x-make-font-unitalic font)))
- (memq 'italic font))))
+ (aref (internal-get-face face frame) 11))
(defalias 'face-doc-string 'face-documentation)
(defun face-documentation (face)
(if (stringp font)
(setq font (or (and (fontset-name-p font)
(or (query-fontset font)
- (instanciate-fontset font)))
+ (instantiate-fontset font)))
(x-resolve-font-name font 'default frame))))
(internal-set-face-1 face 'font font 3 frame))
(t value))))
(defun modify-face (face foreground background stipple
- bold-p italic-p underline-p &optional frame)
+ bold-p italic-p underline-p &optional inverse-p frame)
"Change the display attributes for face FACE.
If the optional FRAME argument is provided, change only
in that frame; otherwise change each frame.
try) or nil. STIPPLE should be a stipple pattern name string or nil.
If nil, means do not change the display attribute corresponding to that arg.
-BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold,
-in italic, and underlined, respectively. If neither nil or t, means do not
-change the display attribute corresponding to that arg.
+BOLD-P, ITALIC-P, UNDERLINE-P, and INVERSE-P specify whether
+the face should be set bold, italic, underlined or in inverse-video,
+respectively. If one of these arguments is neither nil or t, it means do not
+change the display attribute corresponding to that argument.
If called interactively, prompts for a face name and face attributes."
(interactive
(bold-p (y-or-n-p (concat "Should face " face " be bold ")))
(italic-p (y-or-n-p (concat "Should face " face " be italic ")))
(underline-p (y-or-n-p (concat "Should face " face " be underlined ")))
+ (inverse-p (y-or-n-p (concat "Should face " face " be inverse-video ")))
(all-frames-p (y-or-n-p (concat "Modify face " face " in all frames "))))
(message "Face %s: %s" face
(mapconcat 'identity
(and background (concat (downcase background) " background"))
(and stipple (concat (downcase new-stipple-string) " stipple"))
(and bold-p "bold") (and italic-p "italic")
+ (and inverse-p "inverse")
(and underline-p "underline"))) ", "))
(list (intern face) foreground background stipple
- bold-p italic-p underline-p
+ bold-p italic-p underline-p inverse-p
(if all-frames-p nil (selected-frame)))))
+ ;; Clear this before we install the new foreground and background;
+ ;; otherwise, clearing it after would swap them!
+ (when (and (or foreground background) (face-inverse-video-p face))
+ (set-face-inverse-video-p face nil frame)
+ ;; Arrange to restore it after, if we are not setting it now.
+ (or (memq inverse-p '(t nil))
+ (setq inverse-p t)))
(condition-case nil
(face-try-color-list 'set-face-foreground face foreground frame)
(error nil))
(condition-case nil
(set-face-stipple face stipple frame)
(error nil))
+ ;; Now that we have the new colors,
+ (if (memq inverse-p '(nil t))
+ (set-face-inverse-video-p face inverse-p frame))
(cond ((eq bold-p nil)
(if (face-font face frame)
(make-face-unbold face frame t)))
If the face already exists, it is unmodified."
(interactive "SMake face: ")
(or (internal-find-face name)
- (let ((face (make-vector 10 nil)))
+ (let ((face (make-vector 12 nil)))
(aset face 0 'face)
(aset face 1 name)
(let* ((frames (frame-list))
"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))
"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))
"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)
"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)
"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)
;; 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 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)
(vector 'face
(face-name (cdr elt))
(face-id (cdr elt))
- nil nil nil nil nil nil nil)))
+ nil
+ nil nil nil nil
+ nil nil nil nil)))
global-face-data))
(set-frame-face-alist frame faces)
(setq region-face (face-id 'region))
+(defgroup basic-faces nil
+ "The standard faces of Emacs."
+ :prefix "huh"
+ :group 'faces)
+
;; Specify how these faces look, and their documentation.
(let ((all '((bold "Use bold font." ((t (:bold t))))
(bold-italic "Use bold italic font." ((t (:bold t :italic t))))
symbol (nth 0 entry)
doc (nth 1 entry)
spec (nth 2 entry))
+ (custom-add-to-group 'basic-faces symbol 'custom-face)
(put symbol 'face-documentation doc)
(put symbol 'face-defface-spec spec)))
HCoop / bpt / emacs.git / blobdiff