* lisp/faces.el (face-underline-p): Use face-attribute-specified-or.
[bpt/emacs.git] / lisp / faces.el
index b3b0fa9..9e0ca96 100644 (file)
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(defcustom term-file-prefix (purecopy "term/")
+  "If non-nil, Emacs startup performs terminal-specific initialization.
+It does this by: (load (concat term-file-prefix (getenv \"TERM\")))
+
+You may set this variable to nil in your init file if you do not wish
+the terminal-initialization file to be loaded."
+  :type '(choice (const :tag "No terminal-specific initialization" nil)
+                (string :tag "Name of directory with term files"))
+  :group 'terminals)
 
 (declare-function xw-defined-colors "term/common-win" (&optional frame))
 
@@ -89,7 +96,7 @@ ALTERNATIVE2 etc."
 ;; This is defined originally in xfaces.c.
 (defcustom face-font-registry-alternatives
   (mapcar (lambda (arg) (mapcar 'purecopy arg))
-  (if (eq system-type 'windows-nt)
+  (if (featurep 'w32)
       '(("iso8859-1" "ms-oemlatin")
        ("gb2312.1980" "gb2312" "gbk" "gb18030")
        ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
@@ -480,16 +487,21 @@ with the `default' face (which is always completely specified)."
 (defalias 'face-background-pixmap 'face-stipple)
 
 
+;; FIXME all of these -p functions ignore inheritance (cf face-stipple).
+;; Ie, a face that inherits from an underlined face but does not
+;; specify :underline will return nil.
+;; So these functions don't actually tell you anything about how the
+;; face will _appear_.  So not very useful IMO.
 (defun face-underline-p (face &optional frame)
- "Return non-nil if FACE is underlined.
+ "Return non-nil if FACE specifies a non-nil underlining.
 If the optional argument FRAME is given, report on face FACE in that frame.
 If FRAME is t, report on the defaults for face FACE (for new frames).
 If FRAME is omitted or nil, use the selected frame."
- (eq (face-attribute face :underline frame) t))
+ (face-attribute-specified-or (face-attribute face :underline frame) nil))
 
 
 (defun face-inverse-video-p (face &optional frame)
- "Return non-nil if FACE is in inverse video on FRAME.
+ "Return non-nil if FACE specifies a non-nil inverse-video.
 If the optional argument FRAME is given, report on face FACE in that frame.
 If FRAME is t, report on the defaults for face FACE (for new frames).
 If FRAME is omitted or nil, use the selected frame."
@@ -553,23 +565,23 @@ If FACE is a face-alias, get the documentation for the target face."
 
 (defun set-face-attribute (face frame &rest args)
   "Set attributes of FACE on FRAME from ARGS.
+This function overrides the face attributes specified by FACE's
+face spec.  It is mostly intended for internal use only.
 
-If FRAME is nil this function sets the attributes for all
-existing frames, and the default for new frames.  If FRAME is t,
-change the default for new frames (this is done automatically
-each time an attribute is changed on all frames).
+If FRAME is nil, set the attributes for all existing frames, as
+well as the default for new frames.  If FRAME is t, change the
+default for new frames only.
 
-ARGS must come in pairs ATTRIBUTE VALUE.  ATTRIBUTE must be a valid
-face attribute name.  All attributes can be set to `unspecified';
-this fact is not further mentioned below.
+ARGS must come in pairs ATTRIBUTE VALUE.  ATTRIBUTE must be a
+valid face attribute name.  All attributes can be set to
+`unspecified'; this fact is not further mentioned below.
 
 The following attributes are recognized:
 
 `:family'
 
-VALUE must be a string specifying the font family, e.g. ``monospace'',
-or a fontset alias name.  If a font family is specified, wild-cards `*'
-and `?' are allowed.
+VALUE must be a string specifying the font family
+\(e.g. \"Monospace\") or a fontset.
 
 `:foundry'
 
@@ -586,13 +598,13 @@ It must be one of the symbols `ultra-condensed', `extra-condensed',
 
 `: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,
+VALUE specifies the relative or absolute height of the font.  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
+or a function that takes a single argument (the underlying face
+height) and returns the new height.  Note that for the `default'
+face, you must specify an absolute height (since there is nothing
 for it to be relative to).
 
 `:weight'
@@ -613,10 +625,21 @@ VALUE must be a color name, a string.
 
 `:underline'
 
-VALUE specifies whether characters in FACE should be underlined.  If
-VALUE is t, underline with foreground color of the face.  If VALUE is
-a string, underline with that color.  If VALUE is nil, explicitly
-don't underline.
+VALUE specifies whether characters in FACE should be underlined.
+If VALUE is t, underline with foreground color of the face.
+If VALUE is a string, underline with that color.
+If VALUE is nil, explicitly don't underline.
+
+Otherwise, VALUE must be a property list of the form:
+
+`(:color COLOR :style STYLE)'.
+
+COLOR can be a either a color name string or `foreground-color'.
+STYLE can be either `line' or `wave'.
+If a keyword/value pair is missing from the property list, a
+default value will be used for the value.
+The default value of COLOR is the foreground color of the face.
+The default value of STYLE is `line'.
 
 `:overline'
 
@@ -674,19 +697,26 @@ from an X font name:
 
 `:font'
 
-Set font-related face attributes from VALUE.  VALUE must be a valid
-XLFD font name.  If it is a font name pattern, the first matching font
-will be used.
-
-For compatibility with Emacs 20, keywords `:bold' and `:italic' can
-be used to specify that a bold or italic font should be used.  VALUE
-must be t or nil in that case.  A value of `unspecified' is not allowed.
+Set font-related face attributes from VALUE.  VALUE must be a
+valid font name or font object.  Setting this attribute will also
+set the `:family', `:foundry', `:width', `:height', `:weight',
+and `:slant' attributes.
 
 `:inherit'
 
-VALUE is the name of a face from which to inherit attributes, or a list
-of face names.  Attributes from inherited faces are merged into the face
-like an underlying face would be, with higher priority than underlying faces."
+VALUE is the name of a face from which to inherit attributes, or
+a list of face names.  Attributes from inherited faces are merged
+into the face like an underlying face would be, with higher
+priority than underlying faces.
+
+For backward compatibility, the keywords `:bold' and `:italic'
+can be used to specify weight and slant respectively.  This usage
+is considered obsolete.  For these two keywords, the VALUE must
+be either t or nil.  A value of t for `:bold' is equivalent to
+setting `:weight' to `bold', and a value of t for `:italic' is
+equivalent to setting `:slant' to `italic'.  But if `:weight' is
+specified in the face spec, `:bold' is ignored, and if `:slant'
+is specified, `:italic' is ignored."
   (setq args (purecopy args))
   (let ((where (if (null frame) 0 frame))
        (spec args)
@@ -812,21 +842,24 @@ 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-p (face underline &optional frame)
+(defun set-face-underline (face underline &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.
+UNDERLINE t means FACE underlines with its foreground color.
+If UNDERLINE is a string, underline with that color.
+
+UNDERLINE may also be a list of the form (:color COLOR :style STYLE),
+where COLOR is a string or `foreground-color', and STYLE is either
+`line' or `wave'.  :color may be omitted, which means to use the
+foreground color.  :style may be omitted, which means to use a line.
+
 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))))
+  (interactive (read-face-and-attribute :underline))
   (set-face-attribute face frame :underline underline))
 
-(define-obsolete-function-alias 'set-face-underline
-                                'set-face-underline-p "22.1")
+(define-obsolete-function-alias 'set-face-underline-p
+                                'set-face-underline "24.3")
 
 
 (defun set-face-inverse-video-p (face inverse-video-p &optional frame)
@@ -841,6 +874,9 @@ Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
   (set-face-attribute face frame :inverse-video inverse-video-p))
 
 
+;; The -p suffix is a hostage to fortune.  What if we want to extend
+;; this to allow more than boolean options?  Exactly this happened
+;; to set-face-underline-p.
 (defun set-face-bold-p (face bold-p &optional frame)
   "Specify whether face FACE is bold.
 BOLD-P non-nil means FACE should explicitly display bold.
@@ -968,28 +1004,28 @@ Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out
 of a set of discrete values.  Value is `integerp' if ATTRIBUTE expects
 an integer value."
   (let ((valid
-         (case attribute
-           (:family
+         (pcase attribute
+           (`:family
             (if (window-system frame)
                 (mapcar (lambda (x) (cons x x))
                         (font-family-list))
              ;; Only one font on TTYs.
              (list (cons "default" "default"))))
-           (:foundry
+           (`:foundry
            (list nil))
-          (:width
+          (`:width
            (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
                    font-width-table))
-           (:weight
+           (`:weight
            (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
                    font-weight-table))
-          (:slant
+          (`:slant
            (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
                    font-slant-table))
-          (:inverse-video
+          (`:inverse-video
            (mapcar #'(lambda (x) (cons (symbol-name x) x))
                    (internal-lisp-face-attribute-values attribute)))
-           ((:underline :overline :strike-through :box)
+           ((or `:underline `:overline `:strike-through `:box)
             (if (window-system frame)
                 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
                                (internal-lisp-face-attribute-values attribute))
@@ -997,12 +1033,12 @@ an integer value."
                                (defined-colors frame)))
              (mapcar #'(lambda (x) (cons (symbol-name x) x))
                      (internal-lisp-face-attribute-values attribute))))
-           ((:foreground :background)
+           ((or `:foreground `:background)
             (mapcar #'(lambda (c) (cons c c))
                     (defined-colors frame)))
-           ((:height)
+           (`:height
             'integerp)
-           (:stipple
+           (`:stipple
             (and (memq (window-system frame) '(x ns)) ; No stipple on w32
                  (mapcar #'list
                          (apply #'nconc
@@ -1011,11 +1047,11 @@ an integer value."
                                                (file-directory-p dir)
                                                (directory-files dir)))
                                         x-bitmap-file-path)))))
-           (:inherit
+           (`:inherit
             (cons '("none" . nil)
                   (mapcar #'(lambda (c) (cons (symbol-name c) c))
                           (face-list))))
-           (t
+           (_
             (error "Internal error")))))
     (if (and (listp valid) (not (memq attribute '(:inherit))))
        (nconc (list (cons "unspecified" 'unspecified)) valid)
@@ -1089,6 +1125,9 @@ name of the attribute for prompting.  Value is the new attribute value."
           (string-to-number new-value)))))
 
 
+;; FIXME this does allow you to enter the list forms of :box,
+;; :stipple, or :underline, because face-valid-attribute-values does
+;; not return those forms.
 (defun read-face-attribute (face attribute &optional frame)
   "Interactively read a new value for FACE's ATTRIBUTE.
 Optional argument FRAME nil or unspecified means read an attribute value
@@ -1100,12 +1139,11 @@ of a global face.  Value is the new attribute value."
     ;; Represent complex attribute values as strings by printing them
     ;; out.  Stipple can be a vector; (WIDTH HEIGHT DATA).  Box can be
     ;; a list `(:width WIDTH :color COLOR)' or `(:width WIDTH :shadow
-    ;; SHADOW)'.
-    (when (and (or (eq attribute :stipple)
-                  (eq attribute :box))
-              (or (consp old-value)
-                  (vectorp old-value)))
-      (setq old-value (prin1-to-string old-value)))
+    ;; SHADOW)'.  Underline can be `(:color COLOR :style STYLE)'.
+    (and (memq attribute '(:box :stipple :underline))
+        (or (consp old-value)
+            (vectorp old-value))
+        (setq old-value (prin1-to-string old-value)))
     (cond ((listp valid)
           (let ((default
                   (or (car (rassoc old-value valid))
@@ -1135,11 +1173,10 @@ of a global face.  Value is the new attribute value."
     ;; Convert stipple and box value text we read back to a list or
     ;; vector if it looks like one.  This makes the assumption that a
     ;; pixmap file name won't start with an open-paren.
-    (when (and (or (eq attribute :stipple)
-                  (eq attribute :box))
-              (stringp new-value)
-              (string-match "^[[(]" new-value))
-      (setq new-value (read new-value)))
+    (and (memq attribute '(:stipple :box :underline))
+        (stringp new-value)
+        (string-match "^[[(]" new-value)
+        (setq new-value (read new-value)))
     new-value))
 
 (declare-function fontset-list "fontset.c" ())
@@ -1178,8 +1215,8 @@ and the face and its settings are obtained by querying the user."
                          :foreground (or foreground 'unspecified)
                          :background (or background 'unspecified)
                          :stipple stipple
-                         :bold bold-p
-                         :italic italic-p
+                         :weight (if bold-p 'bold 'normal)
+                         :slant (if italic-p 'italic 'normal)
                          :underline underline
                          :inverse-video inverse-p)
     (setq face (read-face-name "Modify face"))
@@ -1522,10 +1559,14 @@ If SPEC is nil, return nil."
              ;; temacs, prior to loading frame.el.
              (unless (and (fboundp 'display-graphic-p)
                           (display-graphic-p frame))
-               '(:family "default" :foundry "default" :width normal
+               `(:family "default" :foundry "default" :width normal
                  :height 1 :weight normal :slant normal
-                 :foreground "unspecified-fg"
-                 :background "unspecified-bg")))
+                 :foreground ,(if (frame-parameter nil 'reverse)
+                                  "unspecified-bg"
+                                "unspecified-fg")
+                 :background ,(if (frame-parameter nil 'reverse)
+                                  "unspecified-fg"
+                                "unspecified-bg"))))
           ;; For all other faces, unspecify all attributes.
           (apply 'append
                  (mapcar (lambda (x) (list (car x) 'unspecified))
@@ -1838,6 +1879,7 @@ Return nil if it has no specified face."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (declare-function x-parse-geometry "frame.c" (string))
+(defvar x-display-name)
 
 (defun x-handle-named-frame-geometry (parameters)
   "Add geometry parameters for a named frame to parameter list PARAMETERS.
@@ -2242,8 +2284,6 @@ terminal type to a different value."
   :version "21.1"
   :group 'mode-line-faces
   :group 'basic-faces)
-;; No need to define aliases of this form for new faces.
-(define-obsolete-face-alias 'modeline 'mode-line "21.1")
 
 (defface mode-line-inactive
   '((default
@@ -2415,7 +2455,7 @@ Note: Other faces cannot inherit from the cursor face."
   :group 'menu
   :group 'basic-faces)
 
-(defface help-argument-name '((((supports :slant italic)) :inherit italic))
+(defface help-argument-name '((t :inherit italic))
   "Face to highlight argument names in *Help* buffers."
   :group 'help)
 
@@ -2429,33 +2469,31 @@ It is used for characters of no fonts too."
   :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)))
+  '((default :weight bold)
+    (((class color) (min-colors 88) (background light)) :foreground "Red1")
+    (((class color) (min-colors 88) (background dark))  :foreground "Pink")
+    (((class color) (min-colors 16) (background light)) :foreground "Red1")
+    (((class color) (min-colors 16) (background dark))  :foreground "Pink")
+    (((class color) (min-colors 8)) :foreground "red")
+    (t :inverse-video t))
   "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)))
+  '((default :weight bold)
+    (((class color) (min-colors 16)) :foreground "DarkOrange")
+    (((class color)) :foreground "yellow"))
   "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)))
+  '((default :weight bold)
+    (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+    (((class color) (min-colors 88) (background dark))  :foreground "Green1")
+    (((class color) (min-colors 16) (background dark))  :foreground "Green")
+    (((class color)) :foreground "green"))
   "Basic face used to indicate successful operation."
   :version "24.1"
   :group 'basic-faces)
@@ -2546,6 +2584,12 @@ also the same size as FACE on FRAME, or fail."
        (car fonts))
     (cdr (assq 'font (frame-parameters (selected-frame))))))
 
+(defcustom font-list-limit 100
+  "This variable is obsolete and has no effect."
+  :type 'integer
+  :group 'display)
+(make-obsolete-variable 'font-list-limit nil "24.3")
+
 (provide 'faces)
 
 ;;; faces.el ends here