(defun face-id (face &optional frame)
"Return the internal ID of face with name FACE.
-If optional argument FRAME is nil or omitted, use the selected frame."
+The optional argument FRAME is ignored, since the internal face ID
+of a face name is the same for all frames."
(check-face face)
(get face 'face))
(defun set-face-background (face color &optional frame)
"Change the background color of face FACE to COLOR (a string).
FRAME nil or not specified means change face on all frames.
-When called interactively, prompt for the face and color."
+COLOR can be a system-defined color name (see `list-colors-display')
+or a hex spec of the form #RRGGBB.
+When called interactively, prompts for the face and color."
(interactive (read-face-and-attribute :background))
(set-face-attribute face frame :background (or color 'unspecified)))
(defun set-face-foreground (face color &optional frame)
"Change the foreground color of face FACE to COLOR (a string).
FRAME nil or not specified means change face on all frames.
-When called interactively, prompt for the face and color."
+COLOR can be a system-defined color name (see `list-colors-display')
+or a hex spec of the form #RRGGBB.
+When called interactively, prompts for the face and color."
(interactive (read-face-and-attribute :foreground))
(set-face-attribute face frame :foreground (or color 'unspecified)))
(get-char-property (point) 'face)))
faces)
;; Make a list of the named faces that the `face' property uses.
- (if (listp faceprop)
+ (if (and (listp faceprop)
+ ;; Don't treat an attribute spec as a list of faces.
+ (not (keywordp (car faceprop)))
+ (not (memq (car faceprop) '(foreground-color background-color))))
(dolist (f faceprop)
(if (symbolp f)
(push f faces)))
(if (symbolp faceprop)
- (setq faces (list faceprop))))
+ (push faceprop faces)))
;; If there are none, try to get a face name from the buffer.
(if (and (null faces)
(memq (intern-soft (thing-at-point 'symbol)) (face-list)))
((member new-value '("unspecified-fg" "unspecified-bg"))
new-value)
(t
- (string-to-int new-value)))))
+ (string-to-number new-value)))))
(defun read-face-attribute (face attribute &optional frame)
;; conflict with Lucid, which uses that name differently.
(defvar help-xref-stack)
-(defun list-faces-display ()
+(defun list-faces-display (&optional regexp)
"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'."
- (interactive)
+`list-faces-sample-text'.
+
+If REGEXP is non-nil, list only those faces with names matching
+this regular expression. When called interactively with a prefix
+arg, prompt for a regular expression."
+ (interactive (list (and current-prefix-arg
+ (read-string "List faces matching regexp: "))))
(let ((faces (sort (face-list) #'string-lessp))
- (face nil)
(frame (selected-frame))
disp-frame window face-name)
+ (when (> (length regexp) 0)
+ (setq faces
+ (delq nil
+ (mapcar (lambda (f)
+ (when (string-match regexp (symbol-name f))
+ f))
+ faces))))
(with-output-to-temp-buffer "*Faces*"
(save-excursion
(set-buffer standard-output)
"\\[help-follow] on a face name to customize it\n"
"or on its sample text for a description of the face.\n\n")))
(setq help-xref-stack nil)
- (while faces
- (setq face (car faces))
- (setq faces (cdr faces))
+ (dolist (face faces)
(setq face-name (symbol-name face))
(insert (format "%25s " face-name))
;; Hyperlink to a customization buffer for the face. Using
(save-excursion
(save-match-data
(search-backward face-name)
+ (setq help-xref-stack-item `(list-faces-display ,regexp))
(help-xref-button 0 'help-customize-face face)))
(let ((beg (point))
(line-beg (line-beginning-position)))
(copy-face (car faces) (car faces) frame disp-frame)
(setq faces (cdr faces)))))))
+
(defun describe-face (face &optional frame)
"Display the properties of face FACE on FRAME.
Interactively, FACE defaults to the faces of the character after point
(insert "Face: " (symbol-name f))
(if (not (facep f))
(insert " undefined face.\n")
- (let ((customize-label "customize this face"))
+ (let ((customize-label "customize this face")
+ file-name)
(princ (concat " (" customize-label ")\n"))
(insert "Documentation: "
(or (face-documentation f)
"Not documented as a face.")
- "\n\n")
+ "\n")
(with-current-buffer standard-output
(save-excursion
(re-search-backward
(concat "\\(" customize-label "\\)") nil t)
(help-xref-button 1 'help-customize-face f)))
+ ;; The next 4 sexps are copied from describe-function-1
+ ;; and simplified.
+ (setq file-name (symbol-file f 'defface))
+ (when file-name
+ (princ "Defined in `")
+ (princ file-name)
+ (princ "'")
+ ;; Make a hyperlink to the library.
+ (save-excursion
+ (re-search-backward "`\\([^`']+\\)'" nil t)
+ (help-xref-button 1 'help-face-def f file-name))
+ (princ ".")
+ (terpri)
+ (terpri))
(dolist (a attrs)
(let ((attr (face-attribute f (car a) frame)))
(insert (make-string (- max-width (length (cdr a))) ?\ )
(unless frame
(setq frame (selected-frame)))
(let ((tail spec)
- result all)
+ result defaults)
(while tail
(let* ((entry (pop tail))
(display (car entry))
- (attrs (cdr entry)))
- (when (face-spec-set-match-display display frame)
- (setq result (if (null (cdr attrs)) ;; was (listp (car attrs))
- ;; Old-style entry, the attribute list is the
- ;; first element.
- (car attrs)
- attrs))
- (if (eq display t)
- (setq all result result nil)
+ (attrs (cdr entry))
+ thisval)
+ ;; Get the attributes as actually specified by this alternative.
+ (setq thisval
+ (if (null (cdr attrs)) ;; was (listp (car attrs))
+ ;; Old-style entry, the attribute list is the
+ ;; first element.
+ (car attrs)
+ attrs))
+
+ ;; If the condition is `default', that sets the default
+ ;; for following conditions.
+ (if (eq display 'default)
+ (setq defaults thisval)
+ ;; Otherwise, if it matches, use it.
+ (when (face-spec-set-match-display display frame)
+ (setq result thisval)
(setq tail nil)))))
- (if all (append result all) result)))
+ (if defaults (append result defaults) result)))
(defun face-spec-reset-face (face &optional frame)
(defface mode-line
- '((((type x w32 mac) (class color))
+ '((((class color) (min-colors 88))
:box (:line-width -1 :style released-button)
:background "grey75" :foreground "black")
(t
:group 'basic-faces)
(defface mode-line-inactive
- '((t
+ '((default
:inherit mode-line)
- (((type x w32 mac) (background light) (class color))
+ (((class color) (min-colors 88) (background light))
:weight light
:box (:line-width -1 :color "grey75" :style nil)
:foreground "grey20" :background "grey90")
- (((type x w32 mac) (background dark) (class color))
+ (((class color) (min-colors 88) (background dark) )
:weight light
:box (:line-width -1 :color "grey40" :style nil)
:foreground "grey80" :background "grey30"))
"Basic mode line face for non-selected windows."
- :version "21.4"
+ :version "22.1"
+ :group 'modeline
+ :group 'basic-faces)
+
+(defface mode-line-highlight
+ '((((class color) (min-colors 88) (background light))
+ :background "RoyalBlue4" :foreground "white")
+ (((class color) (min-colors 88) (background dark))
+ :background "light sky blue" :foreground "black")
+ (t
+ :inverse-video t))
+ "Basic mode line face for highlighting."
+ :version "22.1"
:group 'modeline
:group 'basic-faces)
;; Make `modeline' an alias for `mode-line', for compatibility.
(put 'modeline 'face-alias 'mode-line)
(put 'modeline-inactive 'face-alias 'mode-line-inactive)
+(put 'modeline-higilight 'face-alias 'mode-line-highlight)
(defface header-line
- '((t
+ '((default
:inherit mode-line)
(((type tty))
;; This used to be `:inverse-video t', but that doesn't look very
(defface tool-bar
- '((t
+ '((default
:box (:line-width 1 :style released-button)
:foreground "black")
(((type x w32 mac) (class color))
(defface minibuffer-prompt '((((background dark)) :foreground "cyan")
+ ;; Don't use blue because many users of
+ ;; the MS-DOS port customize their
+ ;; foreground color to be blue.
(((type pc)) :foreground "magenta")
(t :foreground "dark blue"))
"Face for minibuffer prompts."
- :version "21.4"
+ :version "22.1"
:group 'basic-faces)
(setq minibuffer-prompt-properties
(defface secondary-selection
'((((class color) (min-colors 88) (background light))
- :background "yellow")
+ :background "yellow1")
(((class color) (min-colors 88) (background dark))
:background "SkyBlue4")
(((class color) (min-colors 16) (background light))
(defface trailing-whitespace
'((((class color) (background light))
- :background "red")
+ :background "red1")
(((class color) (background dark))
- :background "red")
+ :background "red1")
(t :inverse-video t))
"Basic face for highlighting trailing whitespace."
:version "21.1"
- :group 'font-lock ; like `show-trailing-whitespace'
+ :group 'whitespace ; like `show-trailing-whitespace'
:group 'basic-faces)
-
-(defface glyph
- '((t
- :inherit secondary-selection))
- "Basic face for displaying \\ and ^ in multichar glyphs.
-It is also used for ... in ellipses."
+(defface escape-glyph '((((background dark)) :foreground "cyan")
+ ;; See the comment in minibuffer-prompt for
+ ;; the reason not to use blue on MS-DOS.
+ (((type pc)) :foreground "magenta")
+ (t :foreground "blue"))
+ "Face for characters displayed as ^-sequences or \-sequences."
:group 'basic-faces)
-
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Manipulating font names.