;;; faces.el --- Lisp faces
-;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004
+;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004,2005
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun facep (face)
- "Return non-nil if FACE is a face name."
+ "Return non-nil if FACE is a face name or internal face object.
+Return nil otherwise. A face name can be a string or a symbol.
+An internal face object is a vector of the kind used internally
+to record face data."
(internal-lisp-face-p face))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun face-documentation (face)
- "Get the documentation string for FACE."
- (get face 'face-documentation))
+ "Get the documentation string for FACE.
+If FACE is a face-alias, get the documentation for the target face."
+ (let ((alias (get face 'face-alias))
+ doc)
+ (if alias
+ (progn
+ (setq doc (get alias 'face-documentation))
+ (format "%s is an alias for the face `%s'.%s" face alias
+ (if doc (format "\n%s" doc)
+ "")))
+ (get face 'face-documentation))))
(defun set-face-documentation (face string)
(setq args (purecopy args))
;; If we set the new-frame defaults, this face is modified outside Custom.
(if (memq where '(0 t))
- (put face 'face-modified t))
+ (put (or (get face 'face-alias) face) 'face-modified t))
(while args
(internal-set-lisp-face-attribute face (car args)
(purecopy (cadr args))
Otherwise, return a single face."
(let ((faceprop (or (get-char-property (point) 'read-face-name)
(get-char-property (point) 'face)))
+ (aliasfaces nil)
+ (nonaliasfaces nil)
faces)
- ;; Make a list of the named faces that the `face' property uses.
+ ;; Try to get a face name from the buffer.
+ (if (memq (intern-soft (thing-at-point 'symbol)) (face-list))
+ (setq faces (list (intern-soft (thing-at-point 'symbol)))))
+ ;; Add the named faces that the `face' property uses.
(if (and (listp faceprop)
;; Don't treat an attribute spec as a list of faces.
(not (keywordp (car faceprop)))
(push f faces)))
(if (symbolp 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)))
- (setq faces (list (intern-soft (thing-at-point 'symbol)))))
+
+ ;; Build up the completion tables.
+ (mapatoms (lambda (s)
+ (if (custom-facep s)
+ (if (get s 'face-alias)
+ (push (symbol-name s) aliasfaces)
+ (push (symbol-name s) nonaliasfaces)))))
;; If we only want one, and the default is more than one,
;; discard the unwanted ones now.
(unless multiple
(if faces
(setq faces (list (car faces)))))
+ (require 'crm)
(let* ((input
;; Read the input.
- (completing-read
+ (completing-read-multiple
(if (or faces string-describing-default)
(format "%s (default %s): " prompt
- (if faces (mapconcat 'symbol-name faces ", ")
+ (if faces (mapconcat 'symbol-name faces ",")
string-describing-default))
(format "%s: " prompt))
- obarray 'custom-facep t))
+ (complete-in-turn nonaliasfaces aliasfaces)
+ nil t nil nil
+ (if faces (mapconcat 'symbol-name faces ","))))
;; Canonicalize the output.
(output
- (if (equal input "")
- faces
- (if (stringp input)
- (list (intern input))
- input))))
+ (cond ((or (equal input "") (equal input '("")))
+ faces)
+ ((stringp input)
+ (mapcar 'intern (split-string input ", *" t)))
+ ((listp input)
+ (mapcar 'intern input))
+ (input))))
;; Return either a list of faces or just one face.
(if multiple
output
;; When we reset the face based on its spec, then it is unmodified
;; as far as Custom is concerned.
(if (null frame)
- (put face 'face-modified nil)))
+ (put (or (get face 'face-alias) face) 'face-modified nil)))
(defun face-attr-match-p (face attrs &optional frame)
(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 nor a default for FACE, return nil."
- (or (get face 'saved-face)
+ (or (get face 'customized-face)
+ (get face 'saved-face)
(face-default-spec face)))
\f
(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. Don't set this variable with `setq';
+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. Don't set this variable with `setq';
this won't have the expected effect."
:group 'faces
:set #'(lambda (var value)
(choice-item light)
(choice-item :tag "default" nil)))
+(defvar default-frame-background-mode nil
+ "Internal variable for the default brightness of the background.
+Emacs sets it automatically depending on the terminal type.
+The value `nil' means `dark'. If Emacs runs in non-windowed
+mode from `xterm' or a similar terminal emulator, the value is
+`light'. On rxvt terminals, the value depends on the environment
+variable COLORFGBG.")
(defun frame-set-background-mode (frame)
"Set up display-dependent faces on FRAME.
(intern (downcase bg-resource)))
((and (null window-system) (null bg-color))
;; No way to determine this automatically (?).
- 'dark)
+ (or default-frame-background-mode 'dark))
;; Unspecified frame background color can only happen
;; on tty's.
((member bg-color '(unspecified "unspecified-bg"))
- 'dark)
+ (or default-frame-background-mode 'dark))
((equal bg-color "unspecified-fg") ; inverted colors
- 'light)
+ (if (eq default-frame-background-mode 'light) 'dark 'light))
((>= (apply '+ (x-color-values bg-color frame))
;; Just looking at the screen, colors whose
;; values add up to .6 of the white total
: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))
+ '((((class color) (min-colors 88))
+ :box (:line-width 2 :color "grey40" :style released-button))
+ (t
+ :inherit highlight))
"Basic mode line face for highlighting."
:version "22.1"
:group 'modeline
:group 'basic-faces)
+(defface vertical-border
+ '((((type tty)) :inherit mode-line-inactive))
+ "Face used for vertical window dividers on ttys."
+ :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)
:group 'basic-faces)
-(defface underline '((t :underline t))
+(defface underline '((((supports :underline t))
+ :underline t)
+ (((supports :weight bold))
+ :weight bold)
+ (t :underline t))
"Basic underlined face."
:group 'basic-faces)
:group 'basic-faces)
(defface escape-glyph
- '((((background dark)) :foreground "pink2")
+ '((((background dark)) :foreground "cyan")
;; See the comment in minibuffer-prompt for
;; the reason not to use blue on MS-DOS.
(((type pc)) :foreground "magenta")
- ;; red4 is too light -- rms.
- (t :foreground "blue"))
+ ;; red4 is too dark, but some say blue is too loud.
+ ;; brown seems to work ok. -- rms.
+ (t :foreground "brown"))
"Face for characters displayed as ^-sequences or \-sequences."
:group 'basic-faces
:version "22.1")
-(defface no-break-space
+(defface nobreak-space
'((((class color) (min-colors 88)) :inherit escape-glyph :underline t)
- (((class color) (min-colors 8)) :background "magenta" :foreground )
+ (((class color) (min-colors 8)) :background "magenta")
(t :inverse-video t))
- "Face for non-breaking space."
+ "Face for displaying nobreak space."
:group 'basic-faces
:version "22.1")
(defface shadow
- '((((background dark)) :foreground "grey70")
- (((background light)) :foreground "grey50"))
+ '((((class color grayscale) (min-colors 88) (background light))
+ :foreground "grey50")
+ (((class color grayscale) (min-colors 88) (background dark))
+ :foreground "grey70")
+ (((class color) (min-colors 8) (background light))
+ :foreground "green")
+ (((class color) (min-colors 8) (background dark))
+ :foreground "yellow"))
"Basic face for shadowed text."
:group 'basic-faces
:version "22.1")
(provide 'faces)
-;;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
+;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
;;; faces.el ends here