Otherwise report on the defaults for face FACE (for new frames)."
(aref (internal-get-face face frame) 5))
-(defsubst face-background-pixmap (face &optional frame)
- "Return the background pixmap name of face FACE, or nil if unspecified.
-If the optional argument FRAME is given, report on face FACE in that frame.
-Otherwise report on the defaults for face FACE (for new frames)."
- (aref (internal-get-face face frame) 6))
+;;(defsubst face-background-pixmap (face &optional frame)
+;; "Return the background pixmap name of face FACE, or nil if unspecified.
+;;If the optional argument FRAME is given, report on face FACE in that frame.
+;;Otherwise report on the defaults for face FACE (for new frames)."
+;; (aref (internal-get-face face frame) 6))
(defsubst face-underline-p (face &optional frame)
"Return t if face FACE is underlined.
If the optional FRAME argument is provided, change only
in that frame; otherwise change each frame."
(interactive (internal-face-interactive "font"))
+ (if (stringp font) (setq font (x-resolve-font-name font face frame)))
(internal-set-face-1 face 'font font 3 frame))
(defsubst set-face-foreground (face color &optional frame)
(interactive (internal-face-interactive "background"))
(internal-set-face-1 face 'background color 5 frame))
-(defsubst set-face-background-pixmap (face name &optional frame)
- "Change the background pixmap of face FACE to PIXMAP.
-PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
+;;(defsubst set-face-background-pixmap (face name &optional frame)
+;; "Change the background pixmap of face FACE to PIXMAP.
+;;PIXMAP should be a string, the name of a file of pixmap data.
+;;The directories listed in the `x-bitmap-file-path' variable are searched.
-Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
-where WIDTH and HEIGHT are the size in pixels,
-and DATA is a string, containing the raw bits of the bitmap.
+;;Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
+;;where WIDTH and HEIGHT are the size in pixels,
+;;and DATA is a string, containing the raw bits of the bitmap.
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
- (interactive (internal-face-interactive "background-pixmap"))
- (internal-set-face-1 face 'background-pixmap name 6 frame))
+;;If the optional FRAME argument is provided, change only
+;;in that frame; otherwise change each frame."
+;; (interactive (internal-face-interactive "background-pixmap"))
+;; (internal-set-face-1 face 'background-pixmap name 6 frame))
(defsubst set-face-underline-p (face underline-p &optional frame)
"Specify whether face FACE is underlined. (Yes if UNDERLINE-P is non-nil.)
"Define a new FACE on all frames.
You can modify the font, color, etc of this face with the set-face- functions.
If the face already exists, it is unmodified."
+ (interactive "SMake face: ")
(or (internal-find-face name)
(let ((face (make-vector 8 nil)))
(aset face 0 'face)
(set-face-font new-face (face-font old-face frame) frame)
(set-face-foreground new-face (face-foreground old-face frame) frame)
(set-face-background new-face (face-background old-face frame) frame)
- (set-face-background-pixmap
- new-face (face-background-pixmap old-face frame) frame)
+;;; (set-face-background-pixmap
+;;; new-face (face-background-pixmap old-face frame) frame)
(set-face-underline-p new-face (face-underline-p old-face frame)
frame))
new-face))
(defun face-equal (face1 face2 &optional frame)
- "True if the faces FACE1 and FACE2 display in the the same way."
+ "True if the faces FACE1 and FACE2 display in the same way."
(setq face1 (internal-get-face face1 frame)
face2 (internal-get-face face2 frame))
(and (equal (face-foreground face1 frame) (face-foreground face2 frame))
(null (face-background face frame)))
(or (equal (face-font default frame) (face-font face frame))
(null (face-font face frame)))
- (or (equal (face-background-pixmap default frame)
- (face-background-pixmap face frame))
- (null (face-background-pixmap face frame)))
+;;; (or (equal (face-background-pixmap default frame)
+;;; (face-background-pixmap face frame))
+;;; (null (face-background-pixmap face frame)))
(equal (face-underline-p default frame)
(face-underline-p face frame))
))))
(defun invert-face (face &optional frame)
"Swap the foreground and background colors of face FACE.
If the face doesn't specify both foreground and background, then
-its foreground and background are set to the background and
-foreground of the default face."
+set its foreground and background to the default background and foreground."
(interactive (list (read-face-name "Invert face: ")))
(setq face (internal-get-face face frame))
(let ((fg (face-foreground face frame))
(progn
(set-face-foreground face bg frame)
(set-face-background face fg frame))
- (set-face-foreground face (face-background 'default frame) frame)
- (set-face-background face (face-foreground 'default frame) frame)))
+ (set-face-foreground face (or (face-background 'default frame)
+ (cdr (assq 'background-color (frame-parameters frame))))
+ frame)
+ (set-face-background face (or (face-foreground 'default frame)
+ (cdr (assq 'foreground-color (frame-parameters frame))))
+ frame)))
face)
(condition-case ()
(set-face-font face font frame)
(error nil)))
-
-
-(defun set-default-font (font)
- "Sets the font used for normal text and the modeline to FONT in all frames.
-For finer-grained control, use set-face-font."
- (interactive (list (read-string "Set default font: "
- (face-font 'default (selected-frame)))))
- (set-face-font 'default font)
- (set-face-font 'modeline font))
\f
;; Manipulating font names.
(setq x-font-regexp-weight (concat - weight -))
nil)
+(defun x-resolve-font-name (pattern &optional face frame)
+ "Return a font name matching PATTERN.
+All wildcards in PATTERN become substantiated.
+If PATTERN is nil, return the name of the frame's base font, which never
+contains wildcards.
+Given optional arguments FACE and FRAME, try to return a font which is
+also the same size as FACE on FRAME."
+ (or (symbolp face)
+ (setq face (face-name face)))
+ (and (eq frame t)
+ (setq frame nil))
+ (if pattern
+ (let ((fonts (x-list-fonts pattern face frame)))
+ (or fonts
+ (if face
+ (error "No fonts matching pattern are the same size as `%s'"
+ face)
+ (error "No fonts match `%s'" pattern)))
+ (car fonts))
+ (cdr (assq 'font (frame-parameters (selected-frame))))))
+
(defun x-frob-font-weight (font which)
(if (or (string-match x-font-regexp font)
(string-match x-font-regexp-head font)
(face-font 'default frame)
(cdr (assq 'font (frame-parameters frame)))))
(or (and (setq f2 (x-make-font-bold font))
- (internal-try-face-font face f2))
+ (internal-try-face-font face f2 frame))
(and (setq f2 (x-make-font-demibold font))
- (internal-try-face-font face f2))))
+ (internal-try-face-font face f2 frame))))
(or (not (equal ofont (face-font face)))
(and (not noerror)
- (error "No %s version of %S" face ofont)))))
+ (error "No bold version of %S" font)))))
(defun make-face-italic (face &optional frame noerror)
"Make the font of the given face be italic, if possible.
(face-font 'default frame)
(cdr (assq 'font (frame-parameters frame)))))
(or (and (setq f2 (x-make-font-italic font))
- (internal-try-face-font face f2))
+ (internal-try-face-font face f2 frame))
(and (setq f2 (x-make-font-oblique font))
- (internal-try-face-font face f2))))
+ (internal-try-face-font face f2 frame))))
(or (not (equal ofont (face-font face)))
(and (not noerror)
- (error "No %s version of %S" face ofont)))))
+ (error "No italic version of %S" font)))))
(defun make-face-bold-italic (face &optional frame noerror)
"Make the font of the given face be bold and italic, if possible.
(not (equal font f2))
(setq f3 (x-make-font-bold f2))
(not (equal f2 f3))
- (internal-try-face-font face 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))
+ (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))
+ (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))))
+ (internal-try-face-font face f3 frame))))
(or (not (equal ofont (face-font face)))
(and (not noerror)
- (error "No %s version of %S" face ofont)))))
+ (error "No bold italic version of %S" font)))))
(defun make-face-unbold (face &optional frame noerror)
"Make the font of the given face be non-bold, if possible.
(face-font 'default frame)
(cdr (assq 'font (frame-parameters frame)))))
(setq font (x-make-font-unbold font1))
- (if font (internal-try-face-font face font)))
+ (if font (internal-try-face-font face font frame)))
(or (not (equal ofont (face-font face)))
(and (not noerror)
- (error "No %s version of %S" face ofont)))))
+ (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.
(face-font 'default frame)
(cdr (assq 'font (frame-parameters frame)))))
(setq font (x-make-font-unitalic font1))
- (if font (internal-try-face-font face font)))
+ (if font (internal-try-face-font face font frame)))
(or (not (equal ofont (face-font face)))
(and (not noerror)
- (error "No %s version of %S" face ofont)))))
+ (error "No unitalic version of %S" font1)))))
\f
-;;; Make the builtin faces; the C code knows these as faces 0, 1, and 2,
-;;; respectively, so they must be the first three faces made.
-
+;;; Make the default and modeline faces; the C code knows these as
+;;; faces 0 and 1, respectively, so they must be the first two faces
+;;; made.
(defun face-initialize ()
(make-face 'default)
(make-face 'modeline)
(make-face 'bold)
(make-face 'italic)
(make-face 'bold-italic)
- (make-face 'primary-selection)
+ (make-face 'region)
(make-face 'secondary-selection)
+ (setq region-face (face-id 'region))
+
;; Set up the faces of all existing X Window frames.
(let ((frames (frame-list)))
(while frames
(or (face-differs-from-default-p 'highlight frame)
(condition-case ()
- (if (x-display-color-p)
- (condition-case ()
- (set-face-background 'highlight "darkseagreen2" frame)
- (error (set-face-background 'highlight "green" frame)))
- (set-face-background-pixmap 'highlight "gray1" frame)
- )
+ (condition-case ()
+ (set-face-background 'highlight "darkseagreen2" frame)
+ (error (set-face-background 'highlight "green" frame)))
+;;; (set-face-background-pixmap 'highlight "gray1" frame)
(error (invert-face 'highlight frame))))
- (or (face-differs-from-default-p 'primary-selection frame)
+ (or (face-differs-from-default-p 'region frame)
(condition-case ()
- (if (x-display-color-p)
- (set-face-background 'primary-selection "gray" frame)
- (set-face-background-pixmap 'primary-selection "gray3" frame)
- )
- (error (invert-face 'primary-selection frame))))
+ (set-face-background 'region "gray" frame)
+ (error (invert-face 'region frame))))
+
+ (or (face-differs-from-default-p 'modeline frame)
+ (invert-face 'modeline frame))
(or (face-differs-from-default-p 'secondary-selection frame)
(condition-case ()
- (if (x-display-color-p)
- (condition-case ()
- ;; some older X servers don't have this one.
- (set-face-background 'secondary-selection "paleturquoise"
- frame)
- (error
- (set-face-background 'secondary-selection "green" frame)))
- (set-face-background-pixmap 'secondary-selection "gray1" frame)
- )
+ (condition-case ()
+ ;; some older X servers don't have this one.
+ (set-face-background 'secondary-selection "paleturquoise"
+ frame)
+ (error
+ (set-face-background 'secondary-selection "green" frame)))
+;;; (set-face-background-pixmap 'secondary-selection "gray1" frame)
(error (invert-face 'secondary-selection frame))))
)
(defun internal-x-complain-about-font (face frame)
- (message "No %s version of %S"
- face
- (or (face-font face frame)
- (face-font face t)
- (face-font 'default frame)
- (cdr (assq 'font (frame-parameters frame)))))
- (sit-for 1))
+;;; It's annoying to bother the user about this,
+;;; since it happens under normal circumstances.
+;;; (message "No %s version of %S"
+;;; face
+;;; (or (face-font face frame)
+;;; (face-font face t)
+;;; (face-font 'default frame)
+;;; (cdr (assq 'font (frame-parameters frame)))))
+;;; (sit-for 1)
+ )
\f
;; Like x-create-frame but also set up the faces.
(x-create-frame parameters)
(let* ((frame (x-create-frame parameters))
(faces (copy-alist global-face-data))
- (rest faces)
- default modeline)
+ (rest faces))
(set-frame-face-alist frame faces)
+ (if (cdr (or (assq 'reverse parameters)
+ (assq 'reverse default-frame-alist)
+ (cons nil
+ (x-get-resource "reverseVideo" "ReverseVideo"))))
+ (let ((params (frame-parameters frame)))
+ (modify-frame-parameters
+ frame
+ (list (cons 'foreground-color (cdr (assq 'background-color params)))
+ (cons 'background-color (cdr (assq 'foreground-color params)))
+ (cons 'mouse-color (cdr (assq 'background-color params)))
+ (cons 'cursor-color (cdr (assq 'background-color params)))
+ (cons 'border-color (cdr (assq 'background-color params)))))))
+
;; Copy the vectors that represent the faces.
;; Also fill them in from X resources.
(while rest
(make-face-x-resource-internal (cdr (car rest)) frame t)
(setq rest (cdr rest)))
- (setq default (internal-get-face 'default frame)
- modeline (internal-get-face 'modeline frame))
-
(x-initialize-frame-faces frame)
- ;;; ;; Make sure the modeline face is fully qualified.
- ;;; (if (and (not (face-font modeline frame)) (face-font default frame))
- ;;; (set-face-font modeline (face-font default frame) frame))
- ;;; (if (and (not (face-background modeline frame))
- ;;; (face-background default frame))
- ;;; (set-face-background modeline (face-background default frame) frame))
- ;;; (if (and (not (face-foreground modeline frame))
- ;;; (face-foreground default frame))
- ;;; (set-face-foreground modeline (face-foreground default frame) frame))
frame)))
;; If we are already using x-window frames, initialize faces for them.