]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
Merge Org 7.8.03
[gnu-emacs] / lisp / faces.el
index a46ee6c93f8e9b45c2d3d6becb07e4a26aa1ed59..21193589deb94304f09025024dc34a9c865e47ff 100644 (file)
@@ -1,8 +1,6 @@
 ;;; faces.el --- Lisp faces
 
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-;;   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2011  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -121,7 +119,7 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
 
 
 (defun face-list ()
-  "Return a list of all defined face names."
+  "Return a list of all defined faces."
   (mapcar #'car face-new-frame-defaults))
 
 
@@ -209,7 +207,7 @@ Value is FACE."
 ;; of realized faces.  The ID assigned to Lisp faces is used to
 ;; support faces in display table entries.
 
-(defun face-id (face &optional frame)
+(defun face-id (face &optional _frame)
   "Return the internal ID of face with name FACE.
 If FACE is a face-alias, return the ID of the target face.
 The optional argument FRAME is ignored, since the internal face ID
@@ -590,10 +588,14 @@ It must be one of the symbols `ultra-condensed', `extra-condensed',
 
 `:height'
 
-VALUE must be either an integer specifying the height of the font to use
-in 1/10 pt, a floating point number specifying the amount by which to
-scale any underlying face, or a function, which is called with the old
-height (from the underlying face), and should return the new height.
+VALUE specifies the height of the font, in either absolute or relative
+terms.  An absolute height is an integer, and specifies font height in
+units of 1/10 pt.  A relative height is either a floating point number,
+which specifies a scaling factor for the underlying face height;
+or a function that takes a single argument (the underlying face height)
+and returns the new height.  Note that for the `default' face,
+you can only specify an absolute height (since there is nothing
+for it to be relative to).
 
 `:weight'
 
@@ -722,7 +724,7 @@ like an underlying face would be, with higher priority than underlying faces."
                                          where))
       (setq args (cddr args)))))
 
-(defun make-face-bold (face &optional frame noerror)
+(defun make-face-bold (face &optional frame _noerror)
   "Make the font of FACE be bold, if possible.
 FRAME nil or not specified means change face on all frames.
 Argument NOERROR is ignored and retained for compatibility.
@@ -731,7 +733,7 @@ Use `set-face-attribute' for finer control of the font weight."
   (set-face-attribute face frame :weight 'bold))
 
 
-(defun make-face-unbold (face &optional frame noerror)
+(defun make-face-unbold (face &optional frame _noerror)
   "Make the font of FACE be non-bold, if possible.
 FRAME nil or not specified means change face on all frames.
 Argument NOERROR is ignored and retained for compatibility."
@@ -739,7 +741,7 @@ Argument NOERROR is ignored and retained for compatibility."
   (set-face-attribute face frame :weight 'normal))
 
 
-(defun make-face-italic (face &optional frame noerror)
+(defun make-face-italic (face &optional frame _noerror)
   "Make the font of FACE be italic, if possible.
 FRAME nil or not specified means change face on all frames.
 Argument NOERROR is ignored and retained for compatibility.
@@ -748,7 +750,7 @@ Use `set-face-attribute' for finer control of the font slant."
   (set-face-attribute face frame :slant 'italic))
 
 
-(defun make-face-unitalic (face &optional frame noerror)
+(defun make-face-unitalic (face &optional frame _noerror)
   "Make the font of FACE be non-italic, if possible.
 FRAME nil or not specified means change face on all frames.
 Argument NOERROR is ignored and retained for compatibility."
@@ -756,7 +758,7 @@ Argument NOERROR is ignored and retained for compatibility."
   (set-face-attribute face frame :slant 'normal))
 
 
-(defun make-face-bold-italic (face &optional frame noerror)
+(defun make-face-bold-italic (face &optional frame _noerror)
   "Make the font of FACE be bold and italic, if possible.
 FRAME nil or not specified means change face on all frames.
 Argument NOERROR is ignored and retained for compatibility.
@@ -1253,7 +1255,7 @@ arg, prompt for a regular expression."
        (insert
         (substitute-command-keys
          (concat
-          "Use "
+          "\\<help-mode-map>Use "
           (if (display-mouse-p) "\\[help-follow-mouse] or ")
           "\\[help-follow] on a face name to customize it\n"
           "or on its sample text for a description of the face.\n\n")))
@@ -1411,11 +1413,12 @@ If FRAME is omitted or nil, use the selected frame."
 ;; Parameter FRAME Is kept for call compatibility to with previous
 ;; face implementation.
 
-(defun face-attr-construct (face &optional frame)
-  "Return a `defface'-style attribute list for FACE on FRAME.
+(defun face-attr-construct (face &optional _frame)
+  "Return a `defface'-style attribute list for FACE.
 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."
+VALUE is the specified value of that attribute.
+Argument FRAME is ignored and retained for compatibility."
   (let (result)
     (dolist (entry face-attribute-name-alist result)
       (let* ((attribute (car entry))
@@ -1442,24 +1445,26 @@ If FRAME is nil, the current FRAME is used."
            options (cdr conjunct)
            match (cond ((eq req 'type)
                         (or (memq (window-system frame) options)
+                            (and (memq 'graphic options)
+                                 (memq (window-system frame) '(x w32 ns)))
                             ;; FIXME: This should be revisited to use
                             ;; display-graphic-p, provided that the
                             ;; color selection depends on the number
                             ;; of supported colors, and all defface's
                             ;; are changed to look at number of colors
                             ;; instead of (type graphic) etc.
-                            (and (null (window-system frame))
-                                 (memq 'tty options))
-                            (and (memq 'motif options)
-                                 (featurep 'motif))
-                            (and (memq 'gtk options)
-                                 (featurep 'gtk))
-                            (and (memq 'lucid options)
-                                 (featurep 'x-toolkit)
-                                 (not (featurep 'motif))
-                                 (not (featurep 'gtk)))
-                            (and (memq 'x-toolkit options)
-                                 (featurep 'x-toolkit))))
+                            (if (null (window-system frame))
+                                (memq 'tty options)
+                              (or (and (memq 'motif options)
+                                       (featurep 'motif))
+                                  (and (memq 'gtk options)
+                                       (featurep 'gtk))
+                                  (and (memq 'lucid options)
+                                       (featurep 'x-toolkit)
+                                       (not (featurep 'motif))
+                                       (not (featurep 'gtk)))
+                                  (and (memq 'x-toolkit options)
+                                       (featurep 'x-toolkit))))))
                        ((eq req 'min-colors)
                         (>= (display-color-cells frame) (car options)))
                        ((eq req 'class)
@@ -1575,13 +1580,25 @@ Optional parameter FRAME is the frame whose definition of FACE
 is used.  If nil or omitted, use the selected frame."
   (unless frame
     (setq frame (selected-frame)))
-  (let ((list face-attribute-name-alist)
-       (match t))
+  (let* ((list face-attribute-name-alist)
+        (match t)
+        (bold (and (plist-member attrs :bold)
+                   (not (plist-member attrs :weight))))
+        (italic (and (plist-member attrs :italic)
+                     (not (plist-member attrs :slant))))
+        (plist (if (or bold italic)
+                   (copy-sequence attrs)
+                 attrs)))
+    ;; Handle the Emacs 20 :bold and :italic properties.
+    (if bold
+       (plist-put plist :weight (if bold 'bold 'normal)))
+    (if italic
+       (plist-put plist :slant (if italic 'italic 'normal)))
     (while (and match list)
       (let* ((attr (caar list))
             (specified-value
-             (if (plist-member attrs attr)
-                 (plist-get attrs attr)
+             (if (plist-member plist attr)
+                 (plist-get plist attr)
                'unspecified))
             (value-now (face-attribute face attr frame)))
        (setq match (equal specified-value value-now))
@@ -1639,18 +1656,28 @@ If COLOR is the symbol `unspecified' or one of the strings
 
 (defun color-values (color &optional frame)
   "Return a description of the color named COLOR on frame FRAME.
-The value is a list of integer RGB values--(RED GREEN BLUE).
-These values appear to range from 0 to 65280 or 65535, depending
-on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\).
+COLOR should be a string naming a color (e.g. \"white\"), or a
+string specifying a color's RGB components (e.g. \"#ff12ec\").
+
+Return a list of three integers, (RED GREEN BLUE), each between 0
+and either 65280 or 65535 (the maximum depends on the system).
+Use `color-name-to-rgb' if you want RGB floating-point values
+normalized to 1.0.
+
 If FRAME is omitted or nil, use the selected frame.
 If FRAME cannot display COLOR, the value is nil.
-If COLOR is the symbol `unspecified' or one of the strings
-\"unspecified-fg\" or \"unspecified-bg\", the value is nil."
-  (if (member color '(unspecified "unspecified-fg" "unspecified-bg"))
-      nil
-    (if (memq (framep (or frame (selected-frame))) '(x w32 ns))
-       (xw-color-values color frame)
-      (tty-color-values color frame))))
+
+COLOR can also be the symbol `unspecified' or one of the strings
+\"unspecified-fg\" or \"unspecified-bg\", in which case the
+return value is nil."
+  (cond
+   ((member color '(unspecified "unspecified-fg" "unspecified-bg"))
+    nil)
+   ((memq (framep (or frame (selected-frame))) '(x w32 ns))
+    (xw-color-values color frame))
+   (t
+    (tty-color-values color frame))))
+
 (defalias 'x-color-values 'color-values)
 
 (declare-function xw-display-color-p "xfns.c" (&optional terminal))
@@ -1677,13 +1704,14 @@ If omitted or nil, that stands for the selected frame's display."
       (> (tty-color-gray-shades display) 2)))))
 
 (defun read-color (&optional prompt convert-to-RGB allow-empty-name msg)
-  "Read a color name or RGB triplet of the form \"#RRRRGGGGBBBB\".
+  "Read a color name or RGB triplet.
 Completion is available for color names, but not for RGB triplets.
 
-RGB triplets have the form #XXXXXXXXXXXX, where each X is a hex
-digit.  The number of Xs must be a multiple of 3, with the same
-number of Xs for each of red, green, and blue.  The order is red,
-green, blue.
+RGB triplets have the form \"#RRGGBB\".  Each of the R, G, and B
+components can have one to four digits, but all three components
+must have the same number of digits.  Each digit is a hex value
+between 0 and F; either upper case or lower case for A through F
+are acceptable.
 
 In addition to standard color names and RGB hex values, the
 following are available as color candidates.  In each case, the
@@ -1726,8 +1754,7 @@ resulting color name in the echo area."
                    ((eq flag 'lambda) ; Test completion.
                     (or (memq string colors)
                         (color-defined-p string)))))
-                nil t))
-        hex-string)
+                nil t)))
 
     ;; Process named colors.
     (when (member color colors)
@@ -1797,109 +1824,6 @@ Return nil if it has no specified face."
           (cond ((memq 'background-color face) (cdr (memq 'background-color face)))
                 ((memq ':background face) (cadr (memq ':background face)))))
          (t nil))))                    ; Invalid face value.
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Background mode.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(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 (automatic by 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)
-          (set-default var value)
-          (mapc 'frame-set-background-mode (frame-list)))
-  :initialize 'custom-initialize-changed
-  :type '(choice (const dark)
-                (const light)
-                (const :tag "automatic" nil)))
-
-
-(declare-function x-get-resource "frame.c"
-                 (attribute class &optional component subclass))
-
-(defvar inhibit-frame-set-background-mode nil)
-
-(defun frame-set-background-mode (frame &optional keep-face-specs)
-  "Set up display-dependent faces on FRAME.
-Display-dependent faces are those which have different definitions
-according to the `background-mode' and `display-type' frame parameters.
-
-If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
-face specs for the new background mode."
-  (unless inhibit-frame-set-background-mode
-    (let* ((bg-resource
-           (and (window-system frame)
-                (x-get-resource "backgroundMode" "BackgroundMode")))
-          (bg-color (frame-parameter frame 'background-color))
-          (terminal-bg-mode (terminal-parameter frame 'background-mode))
-          (tty-type (tty-type frame))
-          (default-bg-mode
-            (if (or (window-system frame)
-                    (and tty-type
-                         (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
-                                       tty-type)))
-                'light
-              'dark))
-          (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
-          (bg-mode
-           (cond (frame-background-mode)
-                 (bg-resource (intern (downcase bg-resource)))
-                 (terminal-bg-mode)
-                 ((equal bg-color "unspecified-fg") ; inverted colors
-                  non-default-bg-mode)
-                 ((not (color-values bg-color frame))
-                  default-bg-mode)
-                 ((>= (apply '+ (color-values bg-color frame))
-                      ;; Just looking at the screen, colors whose
-                      ;; values add up to .6 of the white total
-                      ;; still look dark to me.
-                      (* (apply '+ (color-values "white" frame)) .6))
-                  'light)
-                 (t 'dark)))
-          (display-type
-           (cond ((null (window-system frame))
-                  (if (tty-display-color-p frame) 'color 'mono))
-                 ((display-color-p frame)
-                  'color)
-                 ((x-display-grayscale-p frame)
-                  'grayscale)
-                 (t 'mono)))
-          (old-bg-mode
-           (frame-parameter frame 'background-mode))
-          (old-display-type
-           (frame-parameter frame 'display-type)))
-
-      (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
-       (let ((locally-modified-faces nil)
-             ;; Prevent face-spec-recalc from calling this function
-             ;; again, resulting in a loop (bug#911).
-             (inhibit-frame-set-background-mode t)
-             (params (list (cons 'background-mode bg-mode)
-                           (cons 'display-type display-type))))
-         (if keep-face-specs
-             (modify-frame-parameters frame params)
-           ;; If we are recomputing face specs, first collect a list
-           ;; of faces that don't match their face-specs.  These are
-           ;; the faces modified on FRAME, and we avoid changing them
-           ;; below.  Use a negative list to avoid consing (we assume
-           ;; most faces are unmodified).
-           (dolist (face (face-list))
-             (and (not (get face 'face-override-spec))
-                  (not (face-spec-match-p face
-                                          (face-user-default-spec face)
-                                          (selected-frame)))
-                  (push face locally-modified-faces)))
-           ;; Now change to the new frame parameters
-           (modify-frame-parameters frame params)
-           ;; For all unmodified named faces, choose face specs
-           ;; matching the new frame parameters.
-           (dolist (face (face-list))
-             (unless (memq face locally-modified-faces)
-               (face-spec-recalc face frame)))))))))
 
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1996,12 +1920,13 @@ settings, X resources, and `face-new-frame-defaults'.
 Finally, apply any relevant face attributes found amongst the
 frame parameters in PARAMETERS."
   (let ((window-system-p (memq (window-system frame) '(x w32))))
-    (dolist (face (nreverse (face-list))) ;Why reverse?  --Stef
+    ;; The `reverse' is so that `default' goes first.
+    (dolist (face (nreverse (face-list)))
       (condition-case ()
          (progn
            ;; Initialize faces from face spec and custom theme.
            (face-spec-recalc face frame)
-           ;; X resouces for the default face are applied during
+           ;; X resources for the default face are applied during
            ;; `x-create-frame'.
            (and (not (eq face 'default)) window-system-p
                 (make-face-x-resource-internal face frame))
@@ -2141,9 +2066,9 @@ terminal type to a different value."
     (((supports :underline t))
      :underline t)
     (t
-     ;; default to italic, even it doesn't appear to be supported,
-     ;; because in some cases the display engine will do it's own
-     ;; workaround (to `dim' on ttys)
+     ;; Default to italic, even if it doesn't appear to be supported,
+     ;; because in some cases the display engine will do its own
+     ;; workaround (to `dim' on ttys).
      :slant italic))
   "Basic italic face."
   :group 'basic-faces)
@@ -2187,7 +2112,7 @@ terminal type to a different value."
 
 (defface link
   '((((class color) (min-colors 88) (background light))
-     :foreground "blue1" :underline t)
+     :foreground "RoyalBlue3" :underline t)
     (((class color) (background light))
      :foreground "blue" :underline t)
     (((class color) (min-colors 88) (background dark))
@@ -2442,6 +2367,10 @@ used to display the prompt text."
   '((((background light)) :background "black")
     (((background dark))  :background "white"))
   "Basic face for the cursor color under X.
+Currently, only the `:background' attribute is meaningful; all
+other attributes are ignored.  The cursor foreground color is
+taken from the background color of the underlying text.
+
 Note: Other faces cannot inherit from the cursor face."
   :version "21.1"
   :group 'cursor
@@ -2491,12 +2420,45 @@ Note: Other faces cannot inherit from the cursor face."
 It is used for characters of no fonts too."
   :version "24.1"
   :group 'basic-faces)
+
+(defface error
+  '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold))
+    (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold))
+    (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold))
+    (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold))
+    (((class color) (min-colors 8)) (:foreground "red"))
+    (t (:inverse-video t :weight bold)))
+  "Basic face used to highlight errors and to denote failure."
+  :version "24.1"
+  :group 'basic-faces)
+
+(defface warning
+  '((((class color) (min-colors 16)) (:foreground "DarkOrange" :weight bold))
+    (((class color)) (:foreground "yellow" :weight bold))
+    (t (:weight bold)))
+  "Basic face used to highlight warnings."
+  :version "24.1"
+  :group 'basic-faces)
+
+(defface success
+  '((((class color) (min-colors 16) (background light))
+     (:foreground "ForestGreen" :weight bold))
+    (((class color) (min-colors 88) (background dark))
+     (:foreground "Green1" :weight bold))
+    (((class color) (min-colors 16) (background dark))
+     (:foreground "Green" :weight bold))
+    (((class color)) (:foreground "green" :weight bold))
+    (t (:weight bold)))
+  "Basic face used to indicate successful operation."
+  :version "24.1"
+  :group 'basic-faces)
+
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Manipulating font names.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; This is here for compatibilty with Emacs 20.2.  For example,
+;; This is here for compatibility with Emacs 20.2.  For example,
 ;; international/fontset.el uses x-resolve-font-name.  The following
 ;; functions are not used in the face implementation itself.