]> code.delx.au - gnu-emacs/blobdiff - lisp/faces.el
Merge Org 7.8.03
[gnu-emacs] / lisp / faces.el
index b49cdc777be0518356819c9fbbc392a2bc1c1bff..21193589deb94304f09025024dc34a9c865e47ff 100644 (file)
@@ -119,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))
 
 
@@ -207,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
@@ -724,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.
@@ -733,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."
@@ -741,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.
@@ -750,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."
@@ -758,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.
@@ -1255,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")))
@@ -1413,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))
@@ -1444,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)
@@ -1701,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
@@ -1750,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)
@@ -1821,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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2020,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))
@@ -2165,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)
@@ -2211,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))
@@ -2466,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
@@ -2515,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.