X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e44d251c0d57f0cb1c8850e0cb6fcab8e38316d5..ae48944514a529eb78caff789171393fa6c82287:/lisp/faces.el diff --git a/lisp/faces.el b/lisp/faces.el index 8cca01ad43..d02e40a9b4 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1,7 +1,7 @@ ;;; faces.el --- Lisp faces -;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004,2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +;; 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -20,8 +20,8 @@ ;; 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: @@ -204,7 +204,10 @@ If NAME is already a face, it is simply returned." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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)) @@ -382,7 +385,7 @@ completely specified)." (defun face-attribute-merged-with (attribute value faces &optional frame) "Merges ATTRIBUTE, initially VALUE, with faces from FACES until absolute. FACES may be either a single face or a list of faces. -\[This is an internal function]" +\[This is an internal function.]" (cond ((not (face-attribute-relative-p attribute value)) value) ((null faces) @@ -513,8 +516,17 @@ Use `face-attribute' for finer control." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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) @@ -661,7 +673,7 @@ like an underlying face would be, with higher priority than underlying faces." (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)) @@ -758,31 +770,22 @@ and DATA is a string, containing the raw bits of the bitmap." (set-face-attribute face frame :stipple (or stipple 'unspecified))) -(defun set-face-underline (face underline &optional frame) +(defun set-face-underline-p (face underline-p &optional frame) "Specify whether face FACE is underlined. UNDERLINE nil means FACE explicitly doesn't underline. UNDERLINE non-nil means FACE explicitly does underlining with the same of the foreground color. If UNDERLINE is a string, underline with the color named UNDERLINE. FRAME nil or not specified means change face on all frames. -Use `set-face-attribute' to ``unspecify'' underlining." - (interactive - (let ((list (read-face-and-attribute :underline))) - (list (car list) (eq (car (cdr list)) t)))) - (set-face-attribute face frame :underline underline)) - - -(defun set-face-underline-p (face underline-p &optional frame) - "Specify whether face FACE is underlined. -UNDERLINE-P nil means FACE explicitly doesn't underline. -UNDERLINE-P non-nil means FACE explicitly does underlining. -FRAME nil or not specified means change face on all frames. Use `set-face-attribute' to ``unspecify'' underlining." (interactive (let ((list (read-face-and-attribute :underline))) (list (car list) (eq (car (cdr list)) t)))) (set-face-attribute face frame :underline underline-p)) +(define-obsolete-function-alias 'set-face-underline + 'set-face-underline-p "22.1") + (defun set-face-inverse-video-p (face inverse-video-p &optional frame) "Specify whether face FACE is in inverse video. @@ -857,7 +860,10 @@ Otherwise, return a single 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))) @@ -867,10 +873,7 @@ Otherwise, return a single face." (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))))) + (delete-dups faces) ;; Build up the completion tables. (mapatoms (lambda (s) @@ -884,22 +887,27 @@ Otherwise, return a single face." (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)) - (complete-in-turn nonaliasfaces aliasfaces) nil 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 @@ -1079,7 +1087,7 @@ of a global face. Value is the new attribute value." (defun read-face-font (face &optional frame) "Read the name of a font for FACE on FRAME. -If optional argument FRAME Is nil or omitted, use the selected frame." +If optional argument FRAME is nil or omitted, use the selected frame." (let ((completion-ignore-case t)) (completing-read (format "Set font attributes of face `%s' from font: " face) (x-list-fonts "*" nil frame)))) @@ -1087,7 +1095,7 @@ If optional argument FRAME Is nil or omitted, use the selected frame." (defun read-all-face-attributes (face &optional frame) "Interactively read all attributes for FACE. -If optional argument FRAME Is nil or omitted, use the selected frame. +If optional argument FRAME is nil or omitted, use the selected frame. Value is a property list of attribute names and new values." (let (result) (dolist (attribute face-attribute-name-alist result) @@ -1101,7 +1109,7 @@ Value is a property list of attribute names and new values." If optional argument FRAME is nil or omitted, modify the face used for newly created frame, i.e. the global face. For non-interactive use, `set-face-attribute' is preferred. -When called from elisp, if FACE is nil, all arguments but FRAME are ignored +When called from Lisp, if FACE is nil, all arguments but FRAME are ignored and the face and its settings are obtained by querying the user." (interactive) (if face @@ -1300,8 +1308,15 @@ If FRAME is omitted or nil, use the selected frame." (terpri)) (dolist (a attrs) (let ((attr (face-attribute f (car a) frame))) - (insert (make-string (- max-width (length (cdr a))) ?\ ) - (cdr a) ": " (format "%s" attr) "\n"))))) + (insert (make-string (- max-width (length (cdr a))) ?\s) + (cdr a) ": " (format "%s" attr)) + (if (and (eq (car a) :inherit) + (not (eq attr 'unspecified))) + ;; Make a hyperlink to the parent face. + (save-excursion + (re-search-backward ": \\([^:]+\\)" nil t) + (help-xref-button 1 'help-face attr))) + (insert "\n"))))) (terpri))) (print-help-return-message)))) @@ -1314,7 +1329,7 @@ If FRAME is omitted or nil, use the selected frame." ;; face implementation. (defun face-attr-construct (face &optional frame) - "Return a defface-style attribute list for FACE on FRAME. + "Return a `defface'-style attribute list for FACE on FRAME. Value is a property list of pairs ATTRIBUTE VALUE for all specified face attributes of FACE where ATTRIBUTE is the attribute name and VALUE is the specified value of that attribute." @@ -1443,7 +1458,7 @@ If SPEC is nil, do nothing." ;; 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) @@ -1563,6 +1578,13 @@ this won't have the expected effect." (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. @@ -1578,13 +1600,13 @@ according to the `background-mode' and `display-type' frame parameters." (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 @@ -1812,8 +1834,8 @@ created." ;; Update the colors of FACE, after FRAME's own colors have been ;; changed. -(defalias 'frame-update-face-colors 'frame-set-background-mode) -(make-obsolete 'frame-update-face-colors 'frame-set-background-mode "21.1") +(define-obsolete-function-alias 'frame-update-face-colors + 'frame-set-background-mode "21.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1859,19 +1881,17 @@ created." :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-divider - '((default :inherit mode-line-inactive)) +(defface vertical-border + '((((type tty)) :inherit mode-line-inactive)) "Face used for vertical window dividers on ttys." :version "22.1" :group 'modeline @@ -1931,13 +1951,16 @@ created." :group 'basic-faces) -(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." +(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. +By default, Emacs automatically adds this face to the value of +`minibuffer-prompt-properties', which is a list of text properties +used to display the prompt text." :version "22.1" :group 'basic-faces) @@ -2034,7 +2057,7 @@ Note: Other faces cannot inherit from the cursor face." ;; because in some cases the display engine will do it's own ;; workaround (to `dim' on ttys) :slant italic)) - "Basic italic font." + "Basic italic face." :group 'basic-faces) @@ -2106,27 +2129,34 @@ Note: Other faces cannot inherit from the cursor face." :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")